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
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
304 c Here are the energies showed per procesor if the are more processors
305 c per molecule then we sum it up in sum_energy subroutine
306 c print *," Processor",myrank," calls SUM_ENERGY"
307 call sum_energy(energia,.true.)
308 if (dyn_ss) call dyn_set_nss
309 c print *," Processor",myrank," left SUM_ENERGY"
311 time_sumene=time_sumene+MPI_Wtime()-time00
315 c-------------------------------------------------------------------------------
316 subroutine sum_energy(energia,reduce)
317 implicit real*8 (a-h,o-z)
322 cMS$ATTRIBUTES C :: proc_proc
328 include 'COMMON.SETUP'
329 include 'COMMON.IOUNITS'
330 double precision energia(0:n_ene),enebuff(0:n_ene+1)
331 include 'COMMON.FFIELD'
332 include 'COMMON.DERIV'
333 include 'COMMON.INTERACT'
334 include 'COMMON.SBRIDGE'
335 include 'COMMON.CHAIN'
337 include 'COMMON.CONTROL'
338 include 'COMMON.TIME1'
341 if (nfgtasks.gt.1 .and. reduce) then
343 write (iout,*) "energies before REDUCE"
344 call enerprint(energia)
348 enebuff(i)=energia(i)
351 call MPI_Barrier(FG_COMM,IERR)
352 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
354 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
355 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
357 write (iout,*) "energies after REDUCE"
358 call enerprint(energia)
361 time_Reduce=time_Reduce+MPI_Wtime()-time00
363 if (fg_rank.eq.0) then
367 evdw2=energia(2)+energia(18)
383 eello_turn3=energia(8)
384 eello_turn4=energia(9)
391 edihcnstr=energia(19)
396 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
397 & +wang*ebe+wtor*etors+wscloc*escloc
398 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
399 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
400 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
401 & +wbond*estr+Uconst+wsccor*esccor
403 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
404 & +wang*ebe+wtor*etors+wscloc*escloc
405 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
406 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
407 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
408 & +wbond*estr+Uconst+wsccor*esccor
414 if (isnan(etot).ne.0) energia(0)=1.0d+99
416 if (isnan(etot)) energia(0)=1.0d+99
421 idumm=proc_proc(etot,i)
423 call proc_proc(etot,i)
425 if(i.eq.1)energia(0)=1.0d+99
432 c-------------------------------------------------------------------------------
433 subroutine sum_gradient
434 implicit real*8 (a-h,o-z)
439 cMS$ATTRIBUTES C :: proc_proc
444 double precision gradbufc(3,maxres),gradbufx(3,maxres),
445 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
447 include 'COMMON.SETUP'
448 include 'COMMON.IOUNITS'
449 include 'COMMON.FFIELD'
450 include 'COMMON.DERIV'
451 include 'COMMON.INTERACT'
452 include 'COMMON.SBRIDGE'
453 include 'COMMON.CHAIN'
455 include 'COMMON.CONTROL'
456 include 'COMMON.TIME1'
457 include 'COMMON.MAXGRAD'
458 include 'COMMON.SCCOR'
463 write (iout,*) "sum_gradient gvdwc, gvdwx"
465 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
466 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
471 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
472 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
473 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
476 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
477 C in virtual-bond-vector coordinates
480 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
482 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
483 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
485 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
487 c write (iout,'(i5,3f10.5,2x,f10.5)')
488 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
490 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
492 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
493 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
501 gradbufc(j,i)=wsc*gvdwc(j,i)+
502 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
503 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
504 & wel_loc*gel_loc_long(j,i)+
505 & wcorr*gradcorr_long(j,i)+
506 & wcorr5*gradcorr5_long(j,i)+
507 & wcorr6*gradcorr6_long(j,i)+
508 & wturn6*gcorr6_turn_long(j,i)+
515 gradbufc(j,i)=wsc*gvdwc(j,i)+
516 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
517 & welec*gelc_long(j,i)+
519 & wel_loc*gel_loc_long(j,i)+
520 & wcorr*gradcorr_long(j,i)+
521 & wcorr5*gradcorr5_long(j,i)+
522 & wcorr6*gradcorr6_long(j,i)+
523 & wturn6*gcorr6_turn_long(j,i)+
529 if (nfgtasks.gt.1) then
532 write (iout,*) "gradbufc before allreduce"
534 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
540 gradbufc_sum(j,i)=gradbufc(j,i)
543 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
544 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
545 c time_reduce=time_reduce+MPI_Wtime()-time00
547 c write (iout,*) "gradbufc_sum after allreduce"
549 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
554 c time_allreduce=time_allreduce+MPI_Wtime()-time00
562 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
563 write (iout,*) (i," jgrad_start",jgrad_start(i),
564 & " jgrad_end ",jgrad_end(i),
565 & i=igrad_start,igrad_end)
568 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
569 c do not parallelize this part.
571 c do i=igrad_start,igrad_end
572 c do j=jgrad_start(i),jgrad_end(i)
574 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
579 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
583 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
587 write (iout,*) "gradbufc after summing"
589 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
596 write (iout,*) "gradbufc"
598 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
604 gradbufc_sum(j,i)=gradbufc(j,i)
609 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
613 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
618 c gradbufc(k,i)=0.0d0
622 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
627 write (iout,*) "gradbufc after summing"
629 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
637 gradbufc(k,nres)=0.0d0
642 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
643 & wel_loc*gel_loc(j,i)+
644 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
645 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
646 & wel_loc*gel_loc_long(j,i)+
647 & wcorr*gradcorr_long(j,i)+
648 & wcorr5*gradcorr5_long(j,i)+
649 & wcorr6*gradcorr6_long(j,i)+
650 & wturn6*gcorr6_turn_long(j,i))+
652 & wcorr*gradcorr(j,i)+
653 & wturn3*gcorr3_turn(j,i)+
654 & wturn4*gcorr4_turn(j,i)+
655 & wcorr5*gradcorr5(j,i)+
656 & wcorr6*gradcorr6(j,i)+
657 & wturn6*gcorr6_turn(j,i)+
658 & wsccor*gsccorc(j,i)
659 & +wscloc*gscloc(j,i)
661 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
662 & wel_loc*gel_loc(j,i)+
663 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
664 & welec*gelc_long(j,i)
665 & wel_loc*gel_loc_long(j,i)+
666 & wcorr*gcorr_long(j,i)+
667 & wcorr5*gradcorr5_long(j,i)+
668 & wcorr6*gradcorr6_long(j,i)+
669 & wturn6*gcorr6_turn_long(j,i))+
671 & wcorr*gradcorr(j,i)+
672 & wturn3*gcorr3_turn(j,i)+
673 & wturn4*gcorr4_turn(j,i)+
674 & wcorr5*gradcorr5(j,i)+
675 & wcorr6*gradcorr6(j,i)+
676 & wturn6*gcorr6_turn(j,i)+
677 & wsccor*gsccorc(j,i)
678 & +wscloc*gscloc(j,i)
680 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
682 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
683 & wsccor*gsccorx(j,i)
684 & +wscloc*gsclocx(j,i)
688 write (iout,*) "gloc before adding corr"
690 write (iout,*) i,gloc(i,icg)
694 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
695 & +wcorr5*g_corr5_loc(i)
696 & +wcorr6*g_corr6_loc(i)
697 & +wturn4*gel_loc_turn4(i)
698 & +wturn3*gel_loc_turn3(i)
699 & +wturn6*gel_loc_turn6(i)
700 & +wel_loc*gel_loc_loc(i)
703 write (iout,*) "gloc after adding corr"
705 write (iout,*) i,gloc(i,icg)
709 if (nfgtasks.gt.1) then
712 gradbufc(j,i)=gradc(j,i,icg)
713 gradbufx(j,i)=gradx(j,i,icg)
717 glocbuf(i)=gloc(i,icg)
721 write (iout,*) "gloc_sc before reduce"
724 write (iout,*) i,j,gloc_sc(j,i,icg)
731 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
735 call MPI_Barrier(FG_COMM,IERR)
736 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
738 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
739 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
740 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
741 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
742 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
743 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
744 time_reduce=time_reduce+MPI_Wtime()-time00
745 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
746 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
747 time_reduce=time_reduce+MPI_Wtime()-time00
750 write (iout,*) "gloc_sc after reduce"
753 write (iout,*) i,j,gloc_sc(j,i,icg)
759 write (iout,*) "gloc after reduce"
761 write (iout,*) i,gloc(i,icg)
766 if (gnorm_check) then
768 c Compute the maximum elements of the gradient
778 gcorr3_turn_max=0.0d0
779 gcorr4_turn_max=0.0d0
782 gcorr6_turn_max=0.0d0
792 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
793 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
794 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
795 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
796 & gvdwc_scp_max=gvdwc_scp_norm
797 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
798 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
799 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
800 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
801 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
802 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
803 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
804 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
805 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
806 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
807 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
808 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
809 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
811 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
812 & gcorr3_turn_max=gcorr3_turn_norm
813 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
815 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
816 & gcorr4_turn_max=gcorr4_turn_norm
817 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
818 if (gradcorr5_norm.gt.gradcorr5_max)
819 & gradcorr5_max=gradcorr5_norm
820 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
821 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
822 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
824 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
825 & gcorr6_turn_max=gcorr6_turn_norm
826 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
827 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
828 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
829 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
830 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
831 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
832 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
833 if (gradx_scp_norm.gt.gradx_scp_max)
834 & gradx_scp_max=gradx_scp_norm
835 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
836 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
837 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
838 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
839 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
840 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
841 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
842 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
846 open(istat,file=statname,position="append")
848 open(istat,file=statname,access="append")
850 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
851 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
852 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
853 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
854 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
855 & gsccorx_max,gsclocx_max
857 if (gvdwc_max.gt.1.0d4) then
858 write (iout,*) "gvdwc gvdwx gradb gradbx"
860 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
861 & gradb(j,i),gradbx(j,i),j=1,3)
863 call pdbout(0.0d0,'cipiszcze',iout)
869 write (iout,*) "gradc gradx gloc"
871 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
872 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
876 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
880 c-------------------------------------------------------------------------------
881 subroutine rescale_weights(t_bath)
882 implicit real*8 (a-h,o-z)
884 include 'COMMON.IOUNITS'
885 include 'COMMON.FFIELD'
886 include 'COMMON.SBRIDGE'
887 double precision kfac /2.4d0/
888 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
890 c facT=2*temp0/(t_bath+temp0)
891 if (rescale_mode.eq.0) then
897 else if (rescale_mode.eq.1) then
898 facT=kfac/(kfac-1.0d0+t_bath/temp0)
899 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
900 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
901 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
902 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
903 else if (rescale_mode.eq.2) then
909 facT=licznik/dlog(dexp(x)+dexp(-x))
910 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
911 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
912 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
913 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
915 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
916 write (*,*) "Wrong RESCALE_MODE",rescale_mode
918 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
922 welec=weights(3)*fact
923 wcorr=weights(4)*fact3
924 wcorr5=weights(5)*fact4
925 wcorr6=weights(6)*fact5
926 wel_loc=weights(7)*fact2
927 wturn3=weights(8)*fact2
928 wturn4=weights(9)*fact3
929 wturn6=weights(10)*fact5
930 wtor=weights(13)*fact
931 wtor_d=weights(14)*fact2
932 wsccor=weights(21)*fact
936 C------------------------------------------------------------------------
937 subroutine enerprint(energia)
938 implicit real*8 (a-h,o-z)
940 include 'COMMON.IOUNITS'
941 include 'COMMON.FFIELD'
942 include 'COMMON.SBRIDGE'
944 double precision energia(0:n_ene)
949 evdw2=energia(2)+energia(18)
961 eello_turn3=energia(8)
962 eello_turn4=energia(9)
963 eello_turn6=energia(10)
969 edihcnstr=energia(19)
974 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
975 & estr,wbond,ebe,wang,
976 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
978 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
979 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
982 10 format (/'Virtual-chain energies:'//
983 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
984 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
985 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
986 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
987 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
988 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
989 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
990 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
991 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
992 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
993 & ' (SS bridges & dist. cnstr.)'/
994 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
995 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
996 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
997 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
998 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
999 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1000 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1001 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1002 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1003 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1004 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1005 & 'ETOT= ',1pE16.6,' (total)')
1007 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1008 & estr,wbond,ebe,wang,
1009 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1011 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1012 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1013 & ebr*nss,Uconst,etot
1014 10 format (/'Virtual-chain energies:'//
1015 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1016 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1017 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1018 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1019 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1020 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1021 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1022 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1023 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1024 & ' (SS bridges & dist. cnstr.)'/
1025 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1026 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1027 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1028 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1029 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1030 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1031 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1032 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1033 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1034 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1035 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1036 & 'ETOT= ',1pE16.6,' (total)')
1040 C-----------------------------------------------------------------------
1041 subroutine elj(evdw)
1043 C This subroutine calculates the interaction energy of nonbonded side chains
1044 C assuming the LJ potential of interaction.
1046 implicit real*8 (a-h,o-z)
1047 include 'DIMENSIONS'
1048 parameter (accur=1.0d-10)
1049 include 'COMMON.GEO'
1050 include 'COMMON.VAR'
1051 include 'COMMON.LOCAL'
1052 include 'COMMON.CHAIN'
1053 include 'COMMON.DERIV'
1054 include 'COMMON.INTERACT'
1055 include 'COMMON.TORSION'
1056 include 'COMMON.SBRIDGE'
1057 include 'COMMON.NAMES'
1058 include 'COMMON.IOUNITS'
1059 include 'COMMON.CONTACTS'
1061 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1063 do i=iatsc_s,iatsc_e
1064 itypi=iabs(itype(i))
1065 if (itypi.eq.ntyp1) cycle
1066 itypi1=iabs(itype(i+1))
1073 C Calculate SC interaction energy.
1075 do iint=1,nint_gr(i)
1076 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1077 cd & 'iend=',iend(i,iint)
1078 do j=istart(i,iint),iend(i,iint)
1079 itypj=iabs(itype(j))
1080 if (itypj.eq.ntyp1) cycle
1084 C Change 12/1/95 to calculate four-body interactions
1085 rij=xj*xj+yj*yj+zj*zj
1087 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1088 eps0ij=eps(itypi,itypj)
1090 e1=fac*fac*aa(itypi,itypj)
1091 e2=fac*bb(itypi,itypj)
1093 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1094 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1095 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1096 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1097 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1098 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1101 C Calculate the components of the gradient in DC and X
1103 fac=-rrij*(e1+evdwij)
1108 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1109 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1110 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1111 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1115 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1119 C 12/1/95, revised on 5/20/97
1121 C Calculate the contact function. The ith column of the array JCONT will
1122 C contain the numbers of atoms that make contacts with the atom I (of numbers
1123 C greater than I). The arrays FACONT and GACONT will contain the values of
1124 C the contact function and its derivative.
1126 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1127 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1128 C Uncomment next line, if the correlation interactions are contact function only
1129 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1131 sigij=sigma(itypi,itypj)
1132 r0ij=rs0(itypi,itypj)
1134 C Check whether the SC's are not too far to make a contact.
1137 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1138 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1140 if (fcont.gt.0.0D0) then
1141 C If the SC-SC distance if close to sigma, apply spline.
1142 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1143 cAdam & fcont1,fprimcont1)
1144 cAdam fcont1=1.0d0-fcont1
1145 cAdam if (fcont1.gt.0.0d0) then
1146 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1147 cAdam fcont=fcont*fcont1
1149 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1150 cga eps0ij=1.0d0/dsqrt(eps0ij)
1152 cga gg(k)=gg(k)*eps0ij
1154 cga eps0ij=-evdwij*eps0ij
1155 C Uncomment for AL's type of SC correlation interactions.
1156 cadam eps0ij=-evdwij
1157 num_conti=num_conti+1
1158 jcont(num_conti,i)=j
1159 facont(num_conti,i)=fcont*eps0ij
1160 fprimcont=eps0ij*fprimcont/rij
1162 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1163 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1164 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1165 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1166 gacont(1,num_conti,i)=-fprimcont*xj
1167 gacont(2,num_conti,i)=-fprimcont*yj
1168 gacont(3,num_conti,i)=-fprimcont*zj
1169 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1170 cd write (iout,'(2i3,3f10.5)')
1171 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1177 num_cont(i)=num_conti
1181 gvdwc(j,i)=expon*gvdwc(j,i)
1182 gvdwx(j,i)=expon*gvdwx(j,i)
1185 C******************************************************************************
1189 C To save time, the factor of EXPON has been extracted from ALL components
1190 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1193 C******************************************************************************
1196 C-----------------------------------------------------------------------------
1197 subroutine eljk(evdw)
1199 C This subroutine calculates the interaction energy of nonbonded side chains
1200 C assuming the LJK potential of interaction.
1202 implicit real*8 (a-h,o-z)
1203 include 'DIMENSIONS'
1204 include 'COMMON.GEO'
1205 include 'COMMON.VAR'
1206 include 'COMMON.LOCAL'
1207 include 'COMMON.CHAIN'
1208 include 'COMMON.DERIV'
1209 include 'COMMON.INTERACT'
1210 include 'COMMON.IOUNITS'
1211 include 'COMMON.NAMES'
1214 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1216 do i=iatsc_s,iatsc_e
1217 itypi=iabs(itype(i))
1218 if (itypi.eq.ntyp1) cycle
1219 itypi1=iabs(itype(i+1))
1224 C Calculate SC interaction energy.
1226 do iint=1,nint_gr(i)
1227 do j=istart(i,iint),iend(i,iint)
1228 itypj=iabs(itype(j))
1229 if (itypj.eq.ntyp1) cycle
1233 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1234 fac_augm=rrij**expon
1235 e_augm=augm(itypi,itypj)*fac_augm
1236 r_inv_ij=dsqrt(rrij)
1238 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1239 fac=r_shift_inv**expon
1240 e1=fac*fac*aa(itypi,itypj)
1241 e2=fac*bb(itypi,itypj)
1243 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1244 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1245 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1246 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1247 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1248 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1249 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1252 C Calculate the components of the gradient in DC and X
1254 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1259 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1260 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1261 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1262 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1266 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1274 gvdwc(j,i)=expon*gvdwc(j,i)
1275 gvdwx(j,i)=expon*gvdwx(j,i)
1280 C-----------------------------------------------------------------------------
1281 subroutine ebp(evdw)
1283 C This subroutine calculates the interaction energy of nonbonded side chains
1284 C assuming the Berne-Pechukas potential of interaction.
1286 implicit real*8 (a-h,o-z)
1287 include 'DIMENSIONS'
1288 include 'COMMON.GEO'
1289 include 'COMMON.VAR'
1290 include 'COMMON.LOCAL'
1291 include 'COMMON.CHAIN'
1292 include 'COMMON.DERIV'
1293 include 'COMMON.NAMES'
1294 include 'COMMON.INTERACT'
1295 include 'COMMON.IOUNITS'
1296 include 'COMMON.CALC'
1297 common /srutu/ icall
1298 c double precision rrsave(maxdim)
1301 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1303 c if (icall.eq.0) then
1309 do i=iatsc_s,iatsc_e
1310 itypi=iabs(itype(i))
1311 if (itypi.eq.ntyp1) cycle
1312 itypi1=iabs(itype(i+1))
1316 dxi=dc_norm(1,nres+i)
1317 dyi=dc_norm(2,nres+i)
1318 dzi=dc_norm(3,nres+i)
1319 c dsci_inv=dsc_inv(itypi)
1320 dsci_inv=vbld_inv(i+nres)
1322 C Calculate SC interaction energy.
1324 do iint=1,nint_gr(i)
1325 do j=istart(i,iint),iend(i,iint)
1327 itypj=iabs(itype(j))
1328 if (itypj.eq.ntyp1) cycle
1329 c dscj_inv=dsc_inv(itypj)
1330 dscj_inv=vbld_inv(j+nres)
1331 chi1=chi(itypi,itypj)
1332 chi2=chi(itypj,itypi)
1339 alf12=0.5D0*(alf1+alf2)
1340 C For diagnostics only!!!
1353 dxj=dc_norm(1,nres+j)
1354 dyj=dc_norm(2,nres+j)
1355 dzj=dc_norm(3,nres+j)
1356 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1357 cd if (icall.eq.0) then
1363 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1365 C Calculate whole angle-dependent part of epsilon and contributions
1366 C to its derivatives
1367 fac=(rrij*sigsq)**expon2
1368 e1=fac*fac*aa(itypi,itypj)
1369 e2=fac*bb(itypi,itypj)
1370 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1371 eps2der=evdwij*eps3rt
1372 eps3der=evdwij*eps2rt
1373 evdwij=evdwij*eps2rt*eps3rt
1376 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1377 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1378 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1379 cd & restyp(itypi),i,restyp(itypj),j,
1380 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1381 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1382 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1385 C Calculate gradient components.
1386 e1=e1*eps1*eps2rt**2*eps3rt**2
1387 fac=-expon*(e1+evdwij)
1390 C Calculate radial part of the gradient
1394 C Calculate the angular part of the gradient and sum add the contributions
1395 C to the appropriate components of the Cartesian gradient.
1403 C-----------------------------------------------------------------------------
1404 subroutine egb(evdw)
1406 C This subroutine calculates the interaction energy of nonbonded side chains
1407 C assuming the Gay-Berne potential of interaction.
1409 implicit real*8 (a-h,o-z)
1410 include 'DIMENSIONS'
1411 include 'COMMON.GEO'
1412 include 'COMMON.VAR'
1413 include 'COMMON.LOCAL'
1414 include 'COMMON.CHAIN'
1415 include 'COMMON.DERIV'
1416 include 'COMMON.NAMES'
1417 include 'COMMON.INTERACT'
1418 include 'COMMON.IOUNITS'
1419 include 'COMMON.CALC'
1420 include 'COMMON.CONTROL'
1421 include 'COMMON.SBRIDGE'
1424 c write(iout,*) "Jestem w egb(evdw)"
1427 ccccc energy_dec=.false.
1428 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1431 c if (icall.eq.0) lprn=.false.
1433 do i=iatsc_s,iatsc_e
1434 itypi=iabs(itype(i))
1435 if (itypi.eq.ntyp1) cycle
1436 itypi1=iabs(itype(i+1))
1440 dxi=dc_norm(1,nres+i)
1441 dyi=dc_norm(2,nres+i)
1442 dzi=dc_norm(3,nres+i)
1443 c dsci_inv=dsc_inv(itypi)
1444 dsci_inv=vbld_inv(i+nres)
1445 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1446 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1448 C Calculate SC interaction energy.
1450 do iint=1,nint_gr(i)
1451 do j=istart(i,iint),iend(i,iint)
1452 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1454 c write(iout,*) "PRZED ZWYKLE", evdwij
1455 call dyn_ssbond_ene(i,j,evdwij)
1456 c write(iout,*) "PO ZWYKLE", evdwij
1459 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1460 & 'evdw',i,j,evdwij,' ss'
1461 C triple bond artifac removal
1462 do k=j+1,iend(i,iint)
1463 C search over all next residues
1464 if (dyn_ss_mask(k)) then
1465 C check if they are cysteins
1466 C write(iout,*) 'k=',k
1468 c write(iout,*) "PRZED TRI", evdwij
1469 evdwij_przed_tri=evdwij
1470 call triple_ssbond_ene(i,j,k,evdwij)
1471 c if(evdwij_przed_tri.ne.evdwij) then
1472 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1475 c write(iout,*) "PO TRI", evdwij
1476 C call the energy function that removes the artifical triple disulfide
1477 C bond the soubroutine is located in ssMD.F
1479 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1480 & 'evdw',i,j,evdwij,'tss'
1481 endif!dyn_ss_mask(k)
1485 itypj=iabs(itype(j))
1486 if (itypj.eq.ntyp1) cycle
1487 c dscj_inv=dsc_inv(itypj)
1488 dscj_inv=vbld_inv(j+nres)
1489 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1490 c & 1.0d0/vbld(j+nres)
1491 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1492 sig0ij=sigma(itypi,itypj)
1493 chi1=chi(itypi,itypj)
1494 chi2=chi(itypj,itypi)
1501 alf12=0.5D0*(alf1+alf2)
1502 C For diagnostics only!!!
1515 dxj=dc_norm(1,nres+j)
1516 dyj=dc_norm(2,nres+j)
1517 dzj=dc_norm(3,nres+j)
1518 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1519 c write (iout,*) "j",j," dc_norm",
1520 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1521 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1523 C Calculate angle-dependent terms of energy and contributions to their
1527 sig=sig0ij*dsqrt(sigsq)
1528 rij_shift=1.0D0/rij-sig+sig0ij
1529 c for diagnostics; uncomment
1530 c rij_shift=1.2*sig0ij
1531 C I hate to put IF's in the loops, but here don't have another choice!!!!
1532 if (rij_shift.le.0.0D0) then
1534 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1535 cd & restyp(itypi),i,restyp(itypj),j,
1536 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1540 c---------------------------------------------------------------
1541 rij_shift=1.0D0/rij_shift
1542 fac=rij_shift**expon
1543 e1=fac*fac*aa(itypi,itypj)
1544 e2=fac*bb(itypi,itypj)
1545 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1546 eps2der=evdwij*eps3rt
1547 eps3der=evdwij*eps2rt
1548 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1549 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1550 evdwij=evdwij*eps2rt*eps3rt
1553 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1554 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1555 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1556 & restyp(itypi),i,restyp(itypj),j,
1557 & epsi,sigm,chi1,chi2,chip1,chip2,
1558 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1559 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1563 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1566 C Calculate gradient components.
1567 e1=e1*eps1*eps2rt**2*eps3rt**2
1568 fac=-expon*(e1+evdwij)*rij_shift
1572 C Calculate the radial part of the gradient
1576 C Calculate angular part of the gradient.
1582 c write (iout,*) "Number of loop steps in EGB:",ind
1583 cccc energy_dec=.false.
1586 C-----------------------------------------------------------------------------
1587 subroutine egbv(evdw)
1589 C This subroutine calculates the interaction energy of nonbonded side chains
1590 C assuming the Gay-Berne-Vorobjev potential of interaction.
1592 implicit real*8 (a-h,o-z)
1593 include 'DIMENSIONS'
1594 include 'COMMON.GEO'
1595 include 'COMMON.VAR'
1596 include 'COMMON.LOCAL'
1597 include 'COMMON.CHAIN'
1598 include 'COMMON.DERIV'
1599 include 'COMMON.NAMES'
1600 include 'COMMON.INTERACT'
1601 include 'COMMON.IOUNITS'
1602 include 'COMMON.CALC'
1603 common /srutu/ icall
1606 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1609 c if (icall.eq.0) lprn=.true.
1611 do i=iatsc_s,iatsc_e
1612 itypi=iabs(itype(i))
1613 if (itypi.eq.ntyp1) cycle
1614 itypi1=iabs(itype(i+1))
1618 dxi=dc_norm(1,nres+i)
1619 dyi=dc_norm(2,nres+i)
1620 dzi=dc_norm(3,nres+i)
1621 c dsci_inv=dsc_inv(itypi)
1622 dsci_inv=vbld_inv(i+nres)
1624 C Calculate SC interaction energy.
1626 do iint=1,nint_gr(i)
1627 do j=istart(i,iint),iend(i,iint)
1629 itypj=iabs(itype(j))
1630 if (itypj.eq.ntyp1) cycle
1631 c dscj_inv=dsc_inv(itypj)
1632 dscj_inv=vbld_inv(j+nres)
1633 sig0ij=sigma(itypi,itypj)
1634 r0ij=r0(itypi,itypj)
1635 chi1=chi(itypi,itypj)
1636 chi2=chi(itypj,itypi)
1643 alf12=0.5D0*(alf1+alf2)
1644 C For diagnostics only!!!
1657 dxj=dc_norm(1,nres+j)
1658 dyj=dc_norm(2,nres+j)
1659 dzj=dc_norm(3,nres+j)
1660 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1662 C Calculate angle-dependent terms of energy and contributions to their
1666 sig=sig0ij*dsqrt(sigsq)
1667 rij_shift=1.0D0/rij-sig+r0ij
1668 C I hate to put IF's in the loops, but here don't have another choice!!!!
1669 if (rij_shift.le.0.0D0) then
1674 c---------------------------------------------------------------
1675 rij_shift=1.0D0/rij_shift
1676 fac=rij_shift**expon
1677 e1=fac*fac*aa(itypi,itypj)
1678 e2=fac*bb(itypi,itypj)
1679 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1680 eps2der=evdwij*eps3rt
1681 eps3der=evdwij*eps2rt
1682 fac_augm=rrij**expon
1683 e_augm=augm(itypi,itypj)*fac_augm
1684 evdwij=evdwij*eps2rt*eps3rt
1685 evdw=evdw+evdwij+e_augm
1687 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1688 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1689 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1690 & restyp(itypi),i,restyp(itypj),j,
1691 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1692 & chi1,chi2,chip1,chip2,
1693 & eps1,eps2rt**2,eps3rt**2,
1694 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1697 C Calculate gradient components.
1698 e1=e1*eps1*eps2rt**2*eps3rt**2
1699 fac=-expon*(e1+evdwij)*rij_shift
1701 fac=rij*fac-2*expon*rrij*e_augm
1702 C Calculate the radial part of the gradient
1706 C Calculate angular part of the gradient.
1712 C-----------------------------------------------------------------------------
1713 subroutine sc_angular
1714 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1715 C om12. Called by ebp, egb, and egbv.
1717 include 'COMMON.CALC'
1718 include 'COMMON.IOUNITS'
1722 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1723 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1724 om12=dxi*dxj+dyi*dyj+dzi*dzj
1726 C Calculate eps1(om12) and its derivative in om12
1727 faceps1=1.0D0-om12*chiom12
1728 faceps1_inv=1.0D0/faceps1
1729 eps1=dsqrt(faceps1_inv)
1730 C Following variable is eps1*deps1/dom12
1731 eps1_om12=faceps1_inv*chiom12
1736 c write (iout,*) "om12",om12," eps1",eps1
1737 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1742 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1743 sigsq=1.0D0-facsig*faceps1_inv
1744 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1745 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1746 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1752 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1753 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1755 C Calculate eps2 and its derivatives in om1, om2, and om12.
1758 chipom12=chip12*om12
1759 facp=1.0D0-om12*chipom12
1761 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1762 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1763 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1764 C Following variable is the square root of eps2
1765 eps2rt=1.0D0-facp1*facp_inv
1766 C Following three variables are the derivatives of the square root of eps
1767 C in om1, om2, and om12.
1768 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1769 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1770 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1771 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1772 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1773 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1774 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1775 c & " eps2rt_om12",eps2rt_om12
1776 C Calculate whole angle-dependent part of epsilon and contributions
1777 C to its derivatives
1780 C----------------------------------------------------------------------------
1782 implicit real*8 (a-h,o-z)
1783 include 'DIMENSIONS'
1784 include 'COMMON.CHAIN'
1785 include 'COMMON.DERIV'
1786 include 'COMMON.CALC'
1787 include 'COMMON.IOUNITS'
1788 double precision dcosom1(3),dcosom2(3)
1789 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1790 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1791 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1792 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1796 c eom12=evdwij*eps1_om12
1798 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1799 c & " sigder",sigder
1800 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1801 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1803 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1804 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1807 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1809 c write (iout,*) "gg",(gg(k),k=1,3)
1811 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1812 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1813 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1814 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1815 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1816 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1817 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1818 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1819 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1820 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1823 C Calculate the components of the gradient in DC and X
1827 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1831 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1832 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1836 C-----------------------------------------------------------------------
1837 subroutine e_softsphere(evdw)
1839 C This subroutine calculates the interaction energy of nonbonded side chains
1840 C assuming the LJ potential of interaction.
1842 implicit real*8 (a-h,o-z)
1843 include 'DIMENSIONS'
1844 parameter (accur=1.0d-10)
1845 include 'COMMON.GEO'
1846 include 'COMMON.VAR'
1847 include 'COMMON.LOCAL'
1848 include 'COMMON.CHAIN'
1849 include 'COMMON.DERIV'
1850 include 'COMMON.INTERACT'
1851 include 'COMMON.TORSION'
1852 include 'COMMON.SBRIDGE'
1853 include 'COMMON.NAMES'
1854 include 'COMMON.IOUNITS'
1855 include 'COMMON.CONTACTS'
1857 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1859 do i=iatsc_s,iatsc_e
1860 itypi=iabs(itype(i))
1861 if (itypi.eq.ntyp1) cycle
1862 itypi1=iabs(itype(i+1))
1867 C Calculate SC interaction energy.
1869 do iint=1,nint_gr(i)
1870 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1871 cd & 'iend=',iend(i,iint)
1872 do j=istart(i,iint),iend(i,iint)
1873 itypj=iabs(itype(j))
1874 if (itypj.eq.ntyp1) cycle
1878 rij=xj*xj+yj*yj+zj*zj
1879 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1880 r0ij=r0(itypi,itypj)
1882 c print *,i,j,r0ij,dsqrt(rij)
1883 if (rij.lt.r0ijsq) then
1884 evdwij=0.25d0*(rij-r0ijsq)**2
1892 C Calculate the components of the gradient in DC and X
1898 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1899 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1900 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1901 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1905 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1913 C--------------------------------------------------------------------------
1914 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1917 C Soft-sphere potential of p-p interaction
1919 implicit real*8 (a-h,o-z)
1920 include 'DIMENSIONS'
1921 include 'COMMON.CONTROL'
1922 include 'COMMON.IOUNITS'
1923 include 'COMMON.GEO'
1924 include 'COMMON.VAR'
1925 include 'COMMON.LOCAL'
1926 include 'COMMON.CHAIN'
1927 include 'COMMON.DERIV'
1928 include 'COMMON.INTERACT'
1929 include 'COMMON.CONTACTS'
1930 include 'COMMON.TORSION'
1931 include 'COMMON.VECTORS'
1932 include 'COMMON.FFIELD'
1934 cd write(iout,*) 'In EELEC_soft_sphere'
1941 do i=iatel_s,iatel_e
1942 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1946 xmedi=c(1,i)+0.5d0*dxi
1947 ymedi=c(2,i)+0.5d0*dyi
1948 zmedi=c(3,i)+0.5d0*dzi
1950 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1951 do j=ielstart(i),ielend(i)
1952 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1956 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1957 r0ij=rpp(iteli,itelj)
1962 xj=c(1,j)+0.5D0*dxj-xmedi
1963 yj=c(2,j)+0.5D0*dyj-ymedi
1964 zj=c(3,j)+0.5D0*dzj-zmedi
1965 rij=xj*xj+yj*yj+zj*zj
1966 if (rij.lt.r0ijsq) then
1967 evdw1ij=0.25d0*(rij-r0ijsq)**2
1975 C Calculate contributions to the Cartesian gradient.
1981 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1982 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1985 * Loop over residues i+1 thru j-1.
1989 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
1994 cgrad do i=nnt,nct-1
1996 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1998 cgrad do j=i+1,nct-1
2000 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2006 c------------------------------------------------------------------------------
2007 subroutine vec_and_deriv
2008 implicit real*8 (a-h,o-z)
2009 include 'DIMENSIONS'
2013 include 'COMMON.IOUNITS'
2014 include 'COMMON.GEO'
2015 include 'COMMON.VAR'
2016 include 'COMMON.LOCAL'
2017 include 'COMMON.CHAIN'
2018 include 'COMMON.VECTORS'
2019 include 'COMMON.SETUP'
2020 include 'COMMON.TIME1'
2021 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2022 C Compute the local reference systems. For reference system (i), the
2023 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2024 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2026 do i=ivec_start,ivec_end
2030 if (i.eq.nres-1) then
2031 C Case of the last full residue
2032 C Compute the Z-axis
2033 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2034 costh=dcos(pi-theta(nres))
2035 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2039 C Compute the derivatives of uz
2041 uzder(2,1,1)=-dc_norm(3,i-1)
2042 uzder(3,1,1)= dc_norm(2,i-1)
2043 uzder(1,2,1)= dc_norm(3,i-1)
2045 uzder(3,2,1)=-dc_norm(1,i-1)
2046 uzder(1,3,1)=-dc_norm(2,i-1)
2047 uzder(2,3,1)= dc_norm(1,i-1)
2050 uzder(2,1,2)= dc_norm(3,i)
2051 uzder(3,1,2)=-dc_norm(2,i)
2052 uzder(1,2,2)=-dc_norm(3,i)
2054 uzder(3,2,2)= dc_norm(1,i)
2055 uzder(1,3,2)= dc_norm(2,i)
2056 uzder(2,3,2)=-dc_norm(1,i)
2058 C Compute the Y-axis
2061 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2063 C Compute the derivatives of uy
2066 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2067 & -dc_norm(k,i)*dc_norm(j,i-1)
2068 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2070 uyder(j,j,1)=uyder(j,j,1)-costh
2071 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2076 uygrad(l,k,j,i)=uyder(l,k,j)
2077 uzgrad(l,k,j,i)=uzder(l,k,j)
2081 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2082 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2083 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2084 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2087 C Compute the Z-axis
2088 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2089 costh=dcos(pi-theta(i+2))
2090 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2094 C Compute the derivatives of uz
2096 uzder(2,1,1)=-dc_norm(3,i+1)
2097 uzder(3,1,1)= dc_norm(2,i+1)
2098 uzder(1,2,1)= dc_norm(3,i+1)
2100 uzder(3,2,1)=-dc_norm(1,i+1)
2101 uzder(1,3,1)=-dc_norm(2,i+1)
2102 uzder(2,3,1)= dc_norm(1,i+1)
2105 uzder(2,1,2)= dc_norm(3,i)
2106 uzder(3,1,2)=-dc_norm(2,i)
2107 uzder(1,2,2)=-dc_norm(3,i)
2109 uzder(3,2,2)= dc_norm(1,i)
2110 uzder(1,3,2)= dc_norm(2,i)
2111 uzder(2,3,2)=-dc_norm(1,i)
2113 C Compute the Y-axis
2116 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2118 C Compute the derivatives of uy
2121 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2122 & -dc_norm(k,i)*dc_norm(j,i+1)
2123 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2125 uyder(j,j,1)=uyder(j,j,1)-costh
2126 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2131 uygrad(l,k,j,i)=uyder(l,k,j)
2132 uzgrad(l,k,j,i)=uzder(l,k,j)
2136 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2137 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2138 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2139 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2143 vbld_inv_temp(1)=vbld_inv(i+1)
2144 if (i.lt.nres-1) then
2145 vbld_inv_temp(2)=vbld_inv(i+2)
2147 vbld_inv_temp(2)=vbld_inv(i)
2152 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2153 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2158 #if defined(PARVEC) && defined(MPI)
2159 if (nfgtasks1.gt.1) then
2161 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2162 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2163 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2164 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2165 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2167 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2168 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2170 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2171 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2172 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2173 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2174 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2175 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2176 time_gather=time_gather+MPI_Wtime()-time00
2178 c if (fg_rank.eq.0) then
2179 c write (iout,*) "Arrays UY and UZ"
2181 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2188 C-----------------------------------------------------------------------------
2189 subroutine check_vecgrad
2190 implicit real*8 (a-h,o-z)
2191 include 'DIMENSIONS'
2192 include 'COMMON.IOUNITS'
2193 include 'COMMON.GEO'
2194 include 'COMMON.VAR'
2195 include 'COMMON.LOCAL'
2196 include 'COMMON.CHAIN'
2197 include 'COMMON.VECTORS'
2198 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2199 dimension uyt(3,maxres),uzt(3,maxres)
2200 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2201 double precision delta /1.0d-7/
2204 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2205 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2206 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2207 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2208 cd & (dc_norm(if90,i),if90=1,3)
2209 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2210 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2211 cd write(iout,'(a)')
2217 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2218 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2231 cd write (iout,*) 'i=',i
2233 erij(k)=dc_norm(k,i)
2237 dc_norm(k,i)=erij(k)
2239 dc_norm(j,i)=dc_norm(j,i)+delta
2240 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2242 c dc_norm(k,i)=dc_norm(k,i)/fac
2244 c write (iout,*) (dc_norm(k,i),k=1,3)
2245 c write (iout,*) (erij(k),k=1,3)
2248 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2249 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2250 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2251 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2253 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2254 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2255 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2258 dc_norm(k,i)=erij(k)
2261 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2262 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2263 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2264 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2265 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2266 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2267 cd write (iout,'(a)')
2272 C--------------------------------------------------------------------------
2273 subroutine set_matrices
2274 implicit real*8 (a-h,o-z)
2275 include 'DIMENSIONS'
2278 include "COMMON.SETUP"
2280 integer status(MPI_STATUS_SIZE)
2282 include 'COMMON.IOUNITS'
2283 include 'COMMON.GEO'
2284 include 'COMMON.VAR'
2285 include 'COMMON.LOCAL'
2286 include 'COMMON.CHAIN'
2287 include 'COMMON.DERIV'
2288 include 'COMMON.INTERACT'
2289 include 'COMMON.CONTACTS'
2290 include 'COMMON.TORSION'
2291 include 'COMMON.VECTORS'
2292 include 'COMMON.FFIELD'
2293 double precision auxvec(2),auxmat(2,2)
2295 C Compute the virtual-bond-torsional-angle dependent quantities needed
2296 C to calculate the el-loc multibody terms of various order.
2299 do i=ivec_start+2,ivec_end+2
2303 if (i .lt. nres+1) then
2340 if (i .gt. 3 .and. i .lt. nres+1) then
2341 obrot_der(1,i-2)=-sin1
2342 obrot_der(2,i-2)= cos1
2343 Ugder(1,1,i-2)= sin1
2344 Ugder(1,2,i-2)=-cos1
2345 Ugder(2,1,i-2)=-cos1
2346 Ugder(2,2,i-2)=-sin1
2349 obrot2_der(1,i-2)=-dwasin2
2350 obrot2_der(2,i-2)= dwacos2
2351 Ug2der(1,1,i-2)= dwasin2
2352 Ug2der(1,2,i-2)=-dwacos2
2353 Ug2der(2,1,i-2)=-dwacos2
2354 Ug2der(2,2,i-2)=-dwasin2
2356 obrot_der(1,i-2)=0.0d0
2357 obrot_der(2,i-2)=0.0d0
2358 Ugder(1,1,i-2)=0.0d0
2359 Ugder(1,2,i-2)=0.0d0
2360 Ugder(2,1,i-2)=0.0d0
2361 Ugder(2,2,i-2)=0.0d0
2362 obrot2_der(1,i-2)=0.0d0
2363 obrot2_der(2,i-2)=0.0d0
2364 Ug2der(1,1,i-2)=0.0d0
2365 Ug2der(1,2,i-2)=0.0d0
2366 Ug2der(2,1,i-2)=0.0d0
2367 Ug2der(2,2,i-2)=0.0d0
2369 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2370 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2371 iti = itortyp(itype(i-2))
2375 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2376 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2377 iti1 = itortyp(itype(i-1))
2381 cd write (iout,*) '*******i',i,' iti1',iti
2382 cd write (iout,*) 'b1',b1(:,iti)
2383 cd write (iout,*) 'b2',b2(:,iti)
2384 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2385 c if (i .gt. iatel_s+2) then
2386 if (i .gt. nnt+2) then
2387 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2388 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2389 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2391 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2392 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2393 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2394 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2395 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2406 DtUg2(l,k,i-2)=0.0d0
2410 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2411 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2413 muder(k,i-2)=Ub2der(k,i-2)
2415 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2416 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2417 if (itype(i-1).le.ntyp) then
2418 iti1 = itortyp(itype(i-1))
2426 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2428 cd write (iout,*) 'mu ',mu(:,i-2)
2429 cd write (iout,*) 'mu1',mu1(:,i-2)
2430 cd write (iout,*) 'mu2',mu2(:,i-2)
2431 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2433 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2434 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2435 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2436 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2437 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2438 C Vectors and matrices dependent on a single virtual-bond dihedral.
2439 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2440 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2441 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2442 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2443 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2444 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2445 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2446 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2447 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2450 C Matrices dependent on two consecutive virtual-bond dihedrals.
2451 C The order of matrices is from left to right.
2452 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2454 c do i=max0(ivec_start,2),ivec_end
2456 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2457 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2458 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2459 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2460 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2461 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2462 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2463 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2466 #if defined(MPI) && defined(PARMAT)
2468 c if (fg_rank.eq.0) then
2469 write (iout,*) "Arrays UG and UGDER before GATHER"
2471 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2472 & ((ug(l,k,i),l=1,2),k=1,2),
2473 & ((ugder(l,k,i),l=1,2),k=1,2)
2475 write (iout,*) "Arrays UG2 and UG2DER"
2477 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2478 & ((ug2(l,k,i),l=1,2),k=1,2),
2479 & ((ug2der(l,k,i),l=1,2),k=1,2)
2481 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2483 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2484 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2485 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2487 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2489 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2490 & costab(i),sintab(i),costab2(i),sintab2(i)
2492 write (iout,*) "Array MUDER"
2494 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2498 if (nfgtasks.gt.1) then
2500 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2501 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2502 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2504 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2505 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2507 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2508 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2510 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2511 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2513 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2514 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2516 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2517 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2519 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2520 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2522 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2523 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2524 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2525 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2526 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2527 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2528 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2529 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2530 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2531 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2532 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2533 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2534 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2536 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2537 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2539 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2540 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2542 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2543 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2545 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2546 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2548 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2549 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2551 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2552 & ivec_count(fg_rank1),
2553 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2555 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2556 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2558 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2559 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2561 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2562 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2564 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2565 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2567 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2568 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2570 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2571 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2573 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2574 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2576 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2577 & ivec_count(fg_rank1),
2578 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2580 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2581 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2583 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2584 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2586 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2587 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2589 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2590 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2592 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2593 & ivec_count(fg_rank1),
2594 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2596 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2597 & ivec_count(fg_rank1),
2598 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2600 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2601 & ivec_count(fg_rank1),
2602 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2603 & MPI_MAT2,FG_COMM1,IERR)
2604 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2605 & ivec_count(fg_rank1),
2606 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2607 & MPI_MAT2,FG_COMM1,IERR)
2610 c Passes matrix info through the ring
2613 if (irecv.lt.0) irecv=nfgtasks1-1
2616 if (inext.ge.nfgtasks1) inext=0
2618 c write (iout,*) "isend",isend," irecv",irecv
2620 lensend=lentyp(isend)
2621 lenrecv=lentyp(irecv)
2622 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2623 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2624 c & MPI_ROTAT1(lensend),inext,2200+isend,
2625 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2626 c & iprev,2200+irecv,FG_COMM,status,IERR)
2627 c write (iout,*) "Gather ROTAT1"
2629 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2630 c & MPI_ROTAT2(lensend),inext,3300+isend,
2631 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2632 c & iprev,3300+irecv,FG_COMM,status,IERR)
2633 c write (iout,*) "Gather ROTAT2"
2635 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2636 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2637 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2638 & iprev,4400+irecv,FG_COMM,status,IERR)
2639 c write (iout,*) "Gather ROTAT_OLD"
2641 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2642 & MPI_PRECOMP11(lensend),inext,5500+isend,
2643 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2644 & iprev,5500+irecv,FG_COMM,status,IERR)
2645 c write (iout,*) "Gather PRECOMP11"
2647 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2648 & MPI_PRECOMP12(lensend),inext,6600+isend,
2649 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2650 & iprev,6600+irecv,FG_COMM,status,IERR)
2651 c write (iout,*) "Gather PRECOMP12"
2653 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2655 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2656 & MPI_ROTAT2(lensend),inext,7700+isend,
2657 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2658 & iprev,7700+irecv,FG_COMM,status,IERR)
2659 c write (iout,*) "Gather PRECOMP21"
2661 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2662 & MPI_PRECOMP22(lensend),inext,8800+isend,
2663 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2664 & iprev,8800+irecv,FG_COMM,status,IERR)
2665 c write (iout,*) "Gather PRECOMP22"
2667 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2668 & MPI_PRECOMP23(lensend),inext,9900+isend,
2669 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2670 & MPI_PRECOMP23(lenrecv),
2671 & iprev,9900+irecv,FG_COMM,status,IERR)
2672 c write (iout,*) "Gather PRECOMP23"
2677 if (irecv.lt.0) irecv=nfgtasks1-1
2680 time_gather=time_gather+MPI_Wtime()-time00
2683 c if (fg_rank.eq.0) then
2684 write (iout,*) "Arrays UG and UGDER"
2686 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2687 & ((ug(l,k,i),l=1,2),k=1,2),
2688 & ((ugder(l,k,i),l=1,2),k=1,2)
2690 write (iout,*) "Arrays UG2 and UG2DER"
2692 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2693 & ((ug2(l,k,i),l=1,2),k=1,2),
2694 & ((ug2der(l,k,i),l=1,2),k=1,2)
2696 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2698 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2699 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2700 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2702 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2704 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2705 & costab(i),sintab(i),costab2(i),sintab2(i)
2707 write (iout,*) "Array MUDER"
2709 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2715 cd iti = itortyp(itype(i))
2718 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2719 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2724 C--------------------------------------------------------------------------
2725 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2727 C This subroutine calculates the average interaction energy and its gradient
2728 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2729 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2730 C The potential depends both on the distance of peptide-group centers and on
2731 C the orientation of the CA-CA virtual bonds.
2733 implicit real*8 (a-h,o-z)
2737 include 'DIMENSIONS'
2738 include 'COMMON.CONTROL'
2739 include 'COMMON.SETUP'
2740 include 'COMMON.IOUNITS'
2741 include 'COMMON.GEO'
2742 include 'COMMON.VAR'
2743 include 'COMMON.LOCAL'
2744 include 'COMMON.CHAIN'
2745 include 'COMMON.DERIV'
2746 include 'COMMON.INTERACT'
2747 include 'COMMON.CONTACTS'
2748 include 'COMMON.TORSION'
2749 include 'COMMON.VECTORS'
2750 include 'COMMON.FFIELD'
2751 include 'COMMON.TIME1'
2752 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2753 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2754 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2755 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2756 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2757 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2759 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2761 double precision scal_el /1.0d0/
2763 double precision scal_el /0.5d0/
2766 C 13-go grudnia roku pamietnego...
2767 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2768 & 0.0d0,1.0d0,0.0d0,
2769 & 0.0d0,0.0d0,1.0d0/
2770 cd write(iout,*) 'In EELEC'
2772 cd write(iout,*) 'Type',i
2773 cd write(iout,*) 'B1',B1(:,i)
2774 cd write(iout,*) 'B2',B2(:,i)
2775 cd write(iout,*) 'CC',CC(:,:,i)
2776 cd write(iout,*) 'DD',DD(:,:,i)
2777 cd write(iout,*) 'EE',EE(:,:,i)
2779 cd call check_vecgrad
2781 if (icheckgrad.eq.1) then
2783 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2785 dc_norm(k,i)=dc(k,i)*fac
2787 c write (iout,*) 'i',i,' fac',fac
2790 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2791 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2792 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2793 c call vec_and_deriv
2799 time_mat=time_mat+MPI_Wtime()-time01
2803 cd write (iout,*) 'i=',i
2805 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2808 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2809 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2822 cd print '(a)','Enter EELEC'
2823 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2825 gel_loc_loc(i)=0.0d0
2830 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2832 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2834 do i=iturn3_start,iturn3_end
2835 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2836 & .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
2840 dx_normi=dc_norm(1,i)
2841 dy_normi=dc_norm(2,i)
2842 dz_normi=dc_norm(3,i)
2843 xmedi=c(1,i)+0.5d0*dxi
2844 ymedi=c(2,i)+0.5d0*dyi
2845 zmedi=c(3,i)+0.5d0*dzi
2847 call eelecij(i,i+2,ees,evdw1,eel_loc)
2848 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2849 num_cont_hb(i)=num_conti
2851 do i=iturn4_start,iturn4_end
2852 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2853 & .or. itype(i+3).eq.ntyp1
2854 & .or. itype(i+4).eq.ntyp1) cycle
2858 dx_normi=dc_norm(1,i)
2859 dy_normi=dc_norm(2,i)
2860 dz_normi=dc_norm(3,i)
2861 xmedi=c(1,i)+0.5d0*dxi
2862 ymedi=c(2,i)+0.5d0*dyi
2863 zmedi=c(3,i)+0.5d0*dzi
2864 num_conti=num_cont_hb(i)
2865 call eelecij(i,i+3,ees,evdw1,eel_loc)
2866 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2867 & call eturn4(i,eello_turn4)
2868 num_cont_hb(i)=num_conti
2871 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2873 do i=iatel_s,iatel_e
2874 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2878 dx_normi=dc_norm(1,i)
2879 dy_normi=dc_norm(2,i)
2880 dz_normi=dc_norm(3,i)
2881 xmedi=c(1,i)+0.5d0*dxi
2882 ymedi=c(2,i)+0.5d0*dyi
2883 zmedi=c(3,i)+0.5d0*dzi
2884 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2885 num_conti=num_cont_hb(i)
2886 do j=ielstart(i),ielend(i)
2887 c write (iout,*) i,j,itype(i),itype(j)
2888 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2889 call eelecij(i,j,ees,evdw1,eel_loc)
2891 num_cont_hb(i)=num_conti
2893 c write (iout,*) "Number of loop steps in EELEC:",ind
2895 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2896 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2898 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2899 ccc eel_loc=eel_loc+eello_turn3
2900 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2903 C-------------------------------------------------------------------------------
2904 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2905 implicit real*8 (a-h,o-z)
2906 include 'DIMENSIONS'
2910 include 'COMMON.CONTROL'
2911 include 'COMMON.IOUNITS'
2912 include 'COMMON.GEO'
2913 include 'COMMON.VAR'
2914 include 'COMMON.LOCAL'
2915 include 'COMMON.CHAIN'
2916 include 'COMMON.DERIV'
2917 include 'COMMON.INTERACT'
2918 include 'COMMON.CONTACTS'
2919 include 'COMMON.TORSION'
2920 include 'COMMON.VECTORS'
2921 include 'COMMON.FFIELD'
2922 include 'COMMON.TIME1'
2923 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2924 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2925 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2926 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2927 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2928 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2930 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2932 double precision scal_el /1.0d0/
2934 double precision scal_el /0.5d0/
2937 C 13-go grudnia roku pamietnego...
2938 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2939 & 0.0d0,1.0d0,0.0d0,
2940 & 0.0d0,0.0d0,1.0d0/
2941 c time00=MPI_Wtime()
2942 cd write (iout,*) "eelecij",i,j
2946 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2947 aaa=app(iteli,itelj)
2948 bbb=bpp(iteli,itelj)
2949 ael6i=ael6(iteli,itelj)
2950 ael3i=ael3(iteli,itelj)
2954 dx_normj=dc_norm(1,j)
2955 dy_normj=dc_norm(2,j)
2956 dz_normj=dc_norm(3,j)
2957 xj=c(1,j)+0.5D0*dxj-xmedi
2958 yj=c(2,j)+0.5D0*dyj-ymedi
2959 zj=c(3,j)+0.5D0*dzj-zmedi
2960 rij=xj*xj+yj*yj+zj*zj
2966 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2967 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2968 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2969 fac=cosa-3.0D0*cosb*cosg
2971 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2972 if (j.eq.i+2) ev1=scal_el*ev1
2977 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2980 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2981 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2984 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2985 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2986 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2987 cd & xmedi,ymedi,zmedi,xj,yj,zj
2989 if (energy_dec) then
2990 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
2992 &,iteli,itelj,aaa,evdw1
2993 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2997 C Calculate contributions to the Cartesian gradient.
3000 facvdw=-6*rrmij*(ev1+evdwij)
3001 facel=-3*rrmij*(el1+eesij)
3007 * Radial derivatives. First process both termini of the fragment (i,j)
3013 c ghalf=0.5D0*ggg(k)
3014 c gelc(k,i)=gelc(k,i)+ghalf
3015 c gelc(k,j)=gelc(k,j)+ghalf
3017 c 9/28/08 AL Gradient compotents will be summed only at the end
3019 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3020 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3023 * Loop over residues i+1 thru j-1.
3027 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3034 c ghalf=0.5D0*ggg(k)
3035 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3036 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3038 c 9/28/08 AL Gradient compotents will be summed only at the end
3040 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3041 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3044 * Loop over residues i+1 thru j-1.
3048 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3055 fac=-3*rrmij*(facvdw+facvdw+facel)
3060 * Radial derivatives. First process both termini of the fragment (i,j)
3066 c ghalf=0.5D0*ggg(k)
3067 c gelc(k,i)=gelc(k,i)+ghalf
3068 c gelc(k,j)=gelc(k,j)+ghalf
3070 c 9/28/08 AL Gradient compotents will be summed only at the end
3072 gelc_long(k,j)=gelc(k,j)+ggg(k)
3073 gelc_long(k,i)=gelc(k,i)-ggg(k)
3076 * Loop over residues i+1 thru j-1.
3080 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3083 c 9/28/08 AL Gradient compotents will be summed only at the end
3088 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3089 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3095 ecosa=2.0D0*fac3*fac1+fac4
3098 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3099 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3101 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3102 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3104 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3105 cd & (dcosg(k),k=1,3)
3107 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3110 c ghalf=0.5D0*ggg(k)
3111 c gelc(k,i)=gelc(k,i)+ghalf
3112 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3113 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3114 c gelc(k,j)=gelc(k,j)+ghalf
3115 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3116 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3120 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3125 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3126 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3128 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3129 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3130 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3131 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3133 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3134 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3135 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3137 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3138 C energy of a peptide unit is assumed in the form of a second-order
3139 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3140 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3141 C are computed for EVERY pair of non-contiguous peptide groups.
3143 if (j.lt.nres-1) then
3154 muij(kkk)=mu(k,i)*mu(l,j)
3157 cd write (iout,*) 'EELEC: i',i,' j',j
3158 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3159 cd write(iout,*) 'muij',muij
3160 ury=scalar(uy(1,i),erij)
3161 urz=scalar(uz(1,i),erij)
3162 vry=scalar(uy(1,j),erij)
3163 vrz=scalar(uz(1,j),erij)
3164 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3165 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3166 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3167 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3168 fac=dsqrt(-ael6i)*r3ij
3173 cd write (iout,'(4i5,4f10.5)')
3174 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3175 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3176 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3177 cd & uy(:,j),uz(:,j)
3178 cd write (iout,'(4f10.5)')
3179 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3180 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3181 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3182 cd write (iout,'(9f10.5/)')
3183 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3184 C Derivatives of the elements of A in virtual-bond vectors
3185 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3187 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3188 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3189 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3190 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3191 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3192 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3193 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3194 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3195 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3196 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3197 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3198 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3200 C Compute radial contributions to the gradient
3218 C Add the contributions coming from er
3221 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3222 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3223 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3224 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3227 C Derivatives in DC(i)
3228 cgrad ghalf1=0.5d0*agg(k,1)
3229 cgrad ghalf2=0.5d0*agg(k,2)
3230 cgrad ghalf3=0.5d0*agg(k,3)
3231 cgrad ghalf4=0.5d0*agg(k,4)
3232 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3233 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3234 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3235 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3236 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3237 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3238 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3239 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3240 C Derivatives in DC(i+1)
3241 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3242 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3243 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3244 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3245 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3246 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3247 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3248 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3249 C Derivatives in DC(j)
3250 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3251 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3252 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3253 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3254 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3255 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3256 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3257 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3258 C Derivatives in DC(j+1) or DC(nres-1)
3259 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3260 & -3.0d0*vryg(k,3)*ury)
3261 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3262 & -3.0d0*vrzg(k,3)*ury)
3263 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3264 & -3.0d0*vryg(k,3)*urz)
3265 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3266 & -3.0d0*vrzg(k,3)*urz)
3267 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3269 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3282 aggi(k,l)=-aggi(k,l)
3283 aggi1(k,l)=-aggi1(k,l)
3284 aggj(k,l)=-aggj(k,l)
3285 aggj1(k,l)=-aggj1(k,l)
3288 if (j.lt.nres-1) then
3294 aggi(k,l)=-aggi(k,l)
3295 aggi1(k,l)=-aggi1(k,l)
3296 aggj(k,l)=-aggj(k,l)
3297 aggj1(k,l)=-aggj1(k,l)
3308 aggi(k,l)=-aggi(k,l)
3309 aggi1(k,l)=-aggi1(k,l)
3310 aggj(k,l)=-aggj(k,l)
3311 aggj1(k,l)=-aggj1(k,l)
3316 IF (wel_loc.gt.0.0d0) THEN
3317 C Contribution to the local-electrostatic energy coming from the i-j pair
3318 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3320 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3322 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3323 & 'eelloc',i,j,eel_loc_ij
3324 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3326 eel_loc=eel_loc+eel_loc_ij
3327 C Partial derivatives in virtual-bond dihedral angles gamma
3329 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3330 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3331 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3332 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3333 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3334 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3335 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3337 ggg(l)=agg(l,1)*muij(1)+
3338 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3339 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3340 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3341 cgrad ghalf=0.5d0*ggg(l)
3342 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3343 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3347 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3350 C Remaining derivatives of eello
3352 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3353 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3354 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3355 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3356 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3357 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3358 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3359 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3362 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3363 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3364 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3365 & .and. num_conti.le.maxconts) then
3366 c write (iout,*) i,j," entered corr"
3368 C Calculate the contact function. The ith column of the array JCONT will
3369 C contain the numbers of atoms that make contacts with the atom I (of numbers
3370 C greater than I). The arrays FACONT and GACONT will contain the values of
3371 C the contact function and its derivative.
3372 c r0ij=1.02D0*rpp(iteli,itelj)
3373 c r0ij=1.11D0*rpp(iteli,itelj)
3374 r0ij=2.20D0*rpp(iteli,itelj)
3375 c r0ij=1.55D0*rpp(iteli,itelj)
3376 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3377 if (fcont.gt.0.0D0) then
3378 num_conti=num_conti+1
3379 if (num_conti.gt.maxconts) then
3380 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3381 & ' will skip next contacts for this conf.'
3383 jcont_hb(num_conti,i)=j
3384 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3385 cd & " jcont_hb",jcont_hb(num_conti,i)
3386 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3387 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3388 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3390 d_cont(num_conti,i)=rij
3391 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3392 C --- Electrostatic-interaction matrix ---
3393 a_chuj(1,1,num_conti,i)=a22
3394 a_chuj(1,2,num_conti,i)=a23
3395 a_chuj(2,1,num_conti,i)=a32
3396 a_chuj(2,2,num_conti,i)=a33
3397 C --- Gradient of rij
3399 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3406 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3407 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3408 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3409 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3410 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3415 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3416 C Calculate contact energies
3418 wij=cosa-3.0D0*cosb*cosg
3421 c fac3=dsqrt(-ael6i)/r0ij**3
3422 fac3=dsqrt(-ael6i)*r3ij
3423 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3424 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3425 if (ees0tmp.gt.0) then
3426 ees0pij=dsqrt(ees0tmp)
3430 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3431 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3432 if (ees0tmp.gt.0) then
3433 ees0mij=dsqrt(ees0tmp)
3438 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3439 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3440 C Diagnostics. Comment out or remove after debugging!
3441 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3442 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3443 c ees0m(num_conti,i)=0.0D0
3445 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3446 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3447 C Angular derivatives of the contact function
3448 ees0pij1=fac3/ees0pij
3449 ees0mij1=fac3/ees0mij
3450 fac3p=-3.0D0*fac3*rrmij
3451 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3452 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3454 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3455 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3456 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3457 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3458 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3459 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3460 ecosap=ecosa1+ecosa2
3461 ecosbp=ecosb1+ecosb2
3462 ecosgp=ecosg1+ecosg2
3463 ecosam=ecosa1-ecosa2
3464 ecosbm=ecosb1-ecosb2
3465 ecosgm=ecosg1-ecosg2
3474 facont_hb(num_conti,i)=fcont
3475 fprimcont=fprimcont/rij
3476 cd facont_hb(num_conti,i)=1.0D0
3477 C Following line is for diagnostics.
3480 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3481 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3484 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3485 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3487 gggp(1)=gggp(1)+ees0pijp*xj
3488 gggp(2)=gggp(2)+ees0pijp*yj
3489 gggp(3)=gggp(3)+ees0pijp*zj
3490 gggm(1)=gggm(1)+ees0mijp*xj
3491 gggm(2)=gggm(2)+ees0mijp*yj
3492 gggm(3)=gggm(3)+ees0mijp*zj
3493 C Derivatives due to the contact function
3494 gacont_hbr(1,num_conti,i)=fprimcont*xj
3495 gacont_hbr(2,num_conti,i)=fprimcont*yj
3496 gacont_hbr(3,num_conti,i)=fprimcont*zj
3499 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3500 c following the change of gradient-summation algorithm.
3502 cgrad ghalfp=0.5D0*gggp(k)
3503 cgrad ghalfm=0.5D0*gggm(k)
3504 gacontp_hb1(k,num_conti,i)=!ghalfp
3505 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3506 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3507 gacontp_hb2(k,num_conti,i)=!ghalfp
3508 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3509 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3510 gacontp_hb3(k,num_conti,i)=gggp(k)
3511 gacontm_hb1(k,num_conti,i)=!ghalfm
3512 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3513 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3514 gacontm_hb2(k,num_conti,i)=!ghalfm
3515 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3516 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3517 gacontm_hb3(k,num_conti,i)=gggm(k)
3519 C Diagnostics. Comment out or remove after debugging!
3521 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3522 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3523 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3524 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3525 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3526 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3529 endif ! num_conti.le.maxconts
3532 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3535 ghalf=0.5d0*agg(l,k)
3536 aggi(l,k)=aggi(l,k)+ghalf
3537 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3538 aggj(l,k)=aggj(l,k)+ghalf
3541 if (j.eq.nres-1 .and. i.lt.j-2) then
3544 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3549 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3552 C-----------------------------------------------------------------------------
3553 subroutine eturn3(i,eello_turn3)
3554 C Third- and fourth-order contributions from turns
3555 implicit real*8 (a-h,o-z)
3556 include 'DIMENSIONS'
3557 include 'COMMON.IOUNITS'
3558 include 'COMMON.GEO'
3559 include 'COMMON.VAR'
3560 include 'COMMON.LOCAL'
3561 include 'COMMON.CHAIN'
3562 include 'COMMON.DERIV'
3563 include 'COMMON.INTERACT'
3564 include 'COMMON.CONTACTS'
3565 include 'COMMON.TORSION'
3566 include 'COMMON.VECTORS'
3567 include 'COMMON.FFIELD'
3568 include 'COMMON.CONTROL'
3570 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3571 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3572 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3573 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3574 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3575 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3576 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3579 c write (iout,*) "eturn3",i,j,j1,j2
3584 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3586 C Third-order contributions
3593 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3594 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3595 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3596 call transpose2(auxmat(1,1),auxmat1(1,1))
3597 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3598 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3599 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3600 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3601 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3602 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3603 cd & ' eello_turn3_num',4*eello_turn3_num
3604 C Derivatives in gamma(i)
3605 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3606 call transpose2(auxmat2(1,1),auxmat3(1,1))
3607 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3608 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3609 C Derivatives in gamma(i+1)
3610 call matmat2(EUg(1,1,i+1),EUgder(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+1)=gel_loc_turn3(i+1)
3614 & +0.5d0*(pizda(1,1)+pizda(2,2))
3615 C Cartesian derivatives
3617 c ghalf1=0.5d0*agg(l,1)
3618 c ghalf2=0.5d0*agg(l,2)
3619 c ghalf3=0.5d0*agg(l,3)
3620 c ghalf4=0.5d0*agg(l,4)
3621 a_temp(1,1)=aggi(l,1)!+ghalf1
3622 a_temp(1,2)=aggi(l,2)!+ghalf2
3623 a_temp(2,1)=aggi(l,3)!+ghalf3
3624 a_temp(2,2)=aggi(l,4)!+ghalf4
3625 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3626 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3627 & +0.5d0*(pizda(1,1)+pizda(2,2))
3628 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3629 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3630 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3631 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3632 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3633 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3634 & +0.5d0*(pizda(1,1)+pizda(2,2))
3635 a_temp(1,1)=aggj(l,1)!+ghalf1
3636 a_temp(1,2)=aggj(l,2)!+ghalf2
3637 a_temp(2,1)=aggj(l,3)!+ghalf3
3638 a_temp(2,2)=aggj(l,4)!+ghalf4
3639 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3640 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3641 & +0.5d0*(pizda(1,1)+pizda(2,2))
3642 a_temp(1,1)=aggj1(l,1)
3643 a_temp(1,2)=aggj1(l,2)
3644 a_temp(2,1)=aggj1(l,3)
3645 a_temp(2,2)=aggj1(l,4)
3646 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3647 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3648 & +0.5d0*(pizda(1,1)+pizda(2,2))
3652 C-------------------------------------------------------------------------------
3653 subroutine eturn4(i,eello_turn4)
3654 C Third- and fourth-order contributions from turns
3655 implicit real*8 (a-h,o-z)
3656 include 'DIMENSIONS'
3657 include 'COMMON.IOUNITS'
3658 include 'COMMON.GEO'
3659 include 'COMMON.VAR'
3660 include 'COMMON.LOCAL'
3661 include 'COMMON.CHAIN'
3662 include 'COMMON.DERIV'
3663 include 'COMMON.INTERACT'
3664 include 'COMMON.CONTACTS'
3665 include 'COMMON.TORSION'
3666 include 'COMMON.VECTORS'
3667 include 'COMMON.FFIELD'
3668 include 'COMMON.CONTROL'
3670 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3671 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3672 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3673 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3674 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3675 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3676 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3679 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3681 C Fourth-order contributions
3689 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3690 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3691 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3696 iti1=itortyp(itype(i+1))
3697 iti2=itortyp(itype(i+2))
3698 iti3=itortyp(itype(i+3))
3699 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3700 call transpose2(EUg(1,1,i+1),e1t(1,1))
3701 call transpose2(Eug(1,1,i+2),e2t(1,1))
3702 call transpose2(Eug(1,1,i+3),e3t(1,1))
3703 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3704 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3705 s1=scalar2(b1(1,iti2),auxvec(1))
3706 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3707 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3708 s2=scalar2(b1(1,iti1),auxvec(1))
3709 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3710 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3711 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3712 eello_turn4=eello_turn4-(s1+s2+s3)
3713 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3714 & 'eturn4',i,j,-(s1+s2+s3)
3715 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3716 cd & ' eello_turn4_num',8*eello_turn4_num
3717 C Derivatives in gamma(i)
3718 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3719 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3720 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3721 s1=scalar2(b1(1,iti2),auxvec(1))
3722 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3723 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3724 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3725 C Derivatives in gamma(i+1)
3726 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3727 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3728 s2=scalar2(b1(1,iti1),auxvec(1))
3729 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3730 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3731 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3732 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3733 C Derivatives in gamma(i+2)
3734 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3735 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3736 s1=scalar2(b1(1,iti2),auxvec(1))
3737 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3738 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3739 s2=scalar2(b1(1,iti1),auxvec(1))
3740 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3741 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3742 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3743 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3744 C Cartesian derivatives
3745 C Derivatives of this turn contributions in DC(i+2)
3746 if (j.lt.nres-1) then
3748 a_temp(1,1)=agg(l,1)
3749 a_temp(1,2)=agg(l,2)
3750 a_temp(2,1)=agg(l,3)
3751 a_temp(2,2)=agg(l,4)
3752 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3753 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3754 s1=scalar2(b1(1,iti2),auxvec(1))
3755 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3756 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3757 s2=scalar2(b1(1,iti1),auxvec(1))
3758 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3759 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3760 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3762 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3765 C Remaining derivatives of this turn contribution
3767 a_temp(1,1)=aggi(l,1)
3768 a_temp(1,2)=aggi(l,2)
3769 a_temp(2,1)=aggi(l,3)
3770 a_temp(2,2)=aggi(l,4)
3771 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3772 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3773 s1=scalar2(b1(1,iti2),auxvec(1))
3774 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3775 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3776 s2=scalar2(b1(1,iti1),auxvec(1))
3777 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3778 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3779 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3780 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3781 a_temp(1,1)=aggi1(l,1)
3782 a_temp(1,2)=aggi1(l,2)
3783 a_temp(2,1)=aggi1(l,3)
3784 a_temp(2,2)=aggi1(l,4)
3785 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3786 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3787 s1=scalar2(b1(1,iti2),auxvec(1))
3788 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3789 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3790 s2=scalar2(b1(1,iti1),auxvec(1))
3791 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3792 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3793 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3794 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3795 a_temp(1,1)=aggj(l,1)
3796 a_temp(1,2)=aggj(l,2)
3797 a_temp(2,1)=aggj(l,3)
3798 a_temp(2,2)=aggj(l,4)
3799 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3800 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3801 s1=scalar2(b1(1,iti2),auxvec(1))
3802 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3803 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3804 s2=scalar2(b1(1,iti1),auxvec(1))
3805 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3806 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3807 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3808 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3809 a_temp(1,1)=aggj1(l,1)
3810 a_temp(1,2)=aggj1(l,2)
3811 a_temp(2,1)=aggj1(l,3)
3812 a_temp(2,2)=aggj1(l,4)
3813 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3814 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3815 s1=scalar2(b1(1,iti2),auxvec(1))
3816 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3817 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3818 s2=scalar2(b1(1,iti1),auxvec(1))
3819 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3820 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3821 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3822 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3823 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3827 C-----------------------------------------------------------------------------
3828 subroutine vecpr(u,v,w)
3829 implicit real*8(a-h,o-z)
3830 dimension u(3),v(3),w(3)
3831 w(1)=u(2)*v(3)-u(3)*v(2)
3832 w(2)=-u(1)*v(3)+u(3)*v(1)
3833 w(3)=u(1)*v(2)-u(2)*v(1)
3836 C-----------------------------------------------------------------------------
3837 subroutine unormderiv(u,ugrad,unorm,ungrad)
3838 C This subroutine computes the derivatives of a normalized vector u, given
3839 C the derivatives computed without normalization conditions, ugrad. Returns
3842 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3843 double precision vec(3)
3844 double precision scalar
3846 c write (2,*) 'ugrad',ugrad
3849 vec(i)=scalar(ugrad(1,i),u(1))
3851 c write (2,*) 'vec',vec
3854 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3857 c write (2,*) 'ungrad',ungrad
3860 C-----------------------------------------------------------------------------
3861 subroutine escp_soft_sphere(evdw2,evdw2_14)
3863 C This subroutine calculates the excluded-volume interaction energy between
3864 C peptide-group centers and side chains and its gradient in virtual-bond and
3865 C side-chain vectors.
3867 implicit real*8 (a-h,o-z)
3868 include 'DIMENSIONS'
3869 include 'COMMON.GEO'
3870 include 'COMMON.VAR'
3871 include 'COMMON.LOCAL'
3872 include 'COMMON.CHAIN'
3873 include 'COMMON.DERIV'
3874 include 'COMMON.INTERACT'
3875 include 'COMMON.FFIELD'
3876 include 'COMMON.IOUNITS'
3877 include 'COMMON.CONTROL'
3882 cd print '(a)','Enter ESCP'
3883 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3884 do i=iatscp_s,iatscp_e
3885 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3887 xi=0.5D0*(c(1,i)+c(1,i+1))
3888 yi=0.5D0*(c(2,i)+c(2,i+1))
3889 zi=0.5D0*(c(3,i)+c(3,i+1))
3891 do iint=1,nscp_gr(i)
3893 do j=iscpstart(i,iint),iscpend(i,iint)
3894 if (itype(j).eq.ntyp1) cycle
3895 itypj=iabs(itype(j))
3896 C Uncomment following three lines for SC-p interactions
3900 C Uncomment following three lines for Ca-p interactions
3904 rij=xj*xj+yj*yj+zj*zj
3907 if (rij.lt.r0ijsq) then
3908 evdwij=0.25d0*(rij-r0ijsq)**2
3916 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3921 cgrad if (j.lt.i) then
3922 cd write (iout,*) 'j<i'
3923 C Uncomment following three lines for SC-p interactions
3925 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3928 cd write (iout,*) 'j>i'
3930 cgrad ggg(k)=-ggg(k)
3931 C Uncomment following line for SC-p interactions
3932 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3936 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3938 cgrad kstart=min0(i+1,j)
3939 cgrad kend=max0(i-1,j-1)
3940 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3941 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3942 cgrad do k=kstart,kend
3944 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3948 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3949 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3957 C-----------------------------------------------------------------------------
3958 subroutine escp(evdw2,evdw2_14)
3960 C This subroutine calculates the excluded-volume interaction energy between
3961 C peptide-group centers and side chains and its gradient in virtual-bond and
3962 C side-chain vectors.
3964 implicit real*8 (a-h,o-z)
3965 include 'DIMENSIONS'
3966 include 'COMMON.GEO'
3967 include 'COMMON.VAR'
3968 include 'COMMON.LOCAL'
3969 include 'COMMON.CHAIN'
3970 include 'COMMON.DERIV'
3971 include 'COMMON.INTERACT'
3972 include 'COMMON.FFIELD'
3973 include 'COMMON.IOUNITS'
3974 include 'COMMON.CONTROL'
3978 cd print '(a)','Enter ESCP'
3979 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3980 do i=iatscp_s,iatscp_e
3981 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3983 xi=0.5D0*(c(1,i)+c(1,i+1))
3984 yi=0.5D0*(c(2,i)+c(2,i+1))
3985 zi=0.5D0*(c(3,i)+c(3,i+1))
3987 do iint=1,nscp_gr(i)
3989 do j=iscpstart(i,iint),iscpend(i,iint)
3990 itypj=iabs(itype(j))
3991 if (itypj.eq.ntyp1) cycle
3992 C Uncomment following three lines for SC-p interactions
3996 C Uncomment following three lines for Ca-p interactions
4000 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4002 e1=fac*fac*aad(itypj,iteli)
4003 e2=fac*bad(itypj,iteli)
4004 if (iabs(j-i) .le. 2) then
4007 evdw2_14=evdw2_14+e1+e2
4011 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4012 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4015 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4017 fac=-(evdwij+e1)*rrij
4021 cgrad if (j.lt.i) then
4022 cd write (iout,*) 'j<i'
4023 C Uncomment following three lines for SC-p interactions
4025 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4028 cd write (iout,*) 'j>i'
4030 cgrad ggg(k)=-ggg(k)
4031 C Uncomment following line for SC-p interactions
4032 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4033 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4037 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4039 cgrad kstart=min0(i+1,j)
4040 cgrad kend=max0(i-1,j-1)
4041 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4042 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4043 cgrad do k=kstart,kend
4045 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4049 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4050 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4058 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4059 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4060 gradx_scp(j,i)=expon*gradx_scp(j,i)
4063 C******************************************************************************
4067 C To save time the factor EXPON has been extracted from ALL components
4068 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4071 C******************************************************************************
4074 C--------------------------------------------------------------------------
4075 subroutine edis(ehpb)
4077 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4079 implicit real*8 (a-h,o-z)
4080 include 'DIMENSIONS'
4081 include 'COMMON.SBRIDGE'
4082 include 'COMMON.CHAIN'
4083 include 'COMMON.DERIV'
4084 include 'COMMON.VAR'
4085 include 'COMMON.INTERACT'
4086 include 'COMMON.IOUNITS'
4087 include 'COMMON.CONTROL'
4093 C write (iout,*) ,"link_end",link_end,constr_dist
4094 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4095 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4096 if (link_end.eq.0) return
4097 do i=link_start,link_end
4098 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4099 C CA-CA distance used in regularization of structure.
4102 C iii and jjj point to the residues for which the distance is assigned.
4103 if (ii.gt.nres) then
4110 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4111 c & dhpb(i),dhpb1(i),forcon(i)
4112 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4113 C distance and angle dependent SS bond potential.
4114 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4115 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4116 if (.not.dyn_ss .and. i.le.nss) then
4117 C 15/02/13 CC dynamic SSbond - additional check
4118 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4119 & iabs(itype(jjj)).eq.1) then
4120 call ssbond_ene(iii,jjj,eij)
4123 cd write (iout,*) "eij",eij
4124 cd & ' waga=',waga,' fac=',fac
4125 else if (ii.gt.nres .and. jj.gt.nres) then
4126 c Restraints from contact prediction
4128 if (constr_dist.eq.11) then
4129 ehpb=ehpb+fordepth(i)**4.0d0
4130 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4131 fac=fordepth(i)**4.0d0
4132 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4133 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
4134 & ehpb,fordepth(i),dd
4136 if (dhpb1(i).gt.0.0d0) then
4137 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4138 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4139 c write (iout,*) "beta nmr",
4140 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4144 C Get the force constant corresponding to this distance.
4146 C Calculate the contribution to energy.
4147 ehpb=ehpb+waga*rdis*rdis
4148 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4150 C Evaluate gradient.
4156 ggg(j)=fac*(c(j,jj)-c(j,ii))
4159 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4160 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4163 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4164 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4167 C Calculate the distance between the two points and its difference from the
4170 if (constr_dist.eq.11) then
4171 ehpb=ehpb+fordepth(i)**4.0d0
4172 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4173 fac=fordepth(i)**4.0d0
4174 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4175 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
4176 & ehpb,fordepth(i),dd
4178 if (dhpb1(i).gt.0.0d0) then
4179 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4180 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4181 c write (iout,*) "alph nmr",
4182 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4185 C Get the force constant corresponding to this distance.
4187 C Calculate the contribution to energy.
4188 ehpb=ehpb+waga*rdis*rdis
4189 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4191 C Evaluate gradient.
4197 ggg(j)=fac*(c(j,jj)-c(j,ii))
4199 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4200 C If this is a SC-SC distance, we need to calculate the contributions to the
4201 C Cartesian gradient in the SC vectors (ghpbx).
4204 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4205 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4208 cgrad do j=iii,jjj-1
4210 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4214 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4215 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4219 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
4222 C--------------------------------------------------------------------------
4223 subroutine ssbond_ene(i,j,eij)
4225 C Calculate the distance and angle dependent SS-bond potential energy
4226 C using a free-energy function derived based on RHF/6-31G** ab initio
4227 C calculations of diethyl disulfide.
4229 C A. Liwo and U. Kozlowska, 11/24/03
4231 implicit real*8 (a-h,o-z)
4232 include 'DIMENSIONS'
4233 include 'COMMON.SBRIDGE'
4234 include 'COMMON.CHAIN'
4235 include 'COMMON.DERIV'
4236 include 'COMMON.LOCAL'
4237 include 'COMMON.INTERACT'
4238 include 'COMMON.VAR'
4239 include 'COMMON.IOUNITS'
4240 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4241 itypi=iabs(itype(i))
4245 dxi=dc_norm(1,nres+i)
4246 dyi=dc_norm(2,nres+i)
4247 dzi=dc_norm(3,nres+i)
4248 c dsci_inv=dsc_inv(itypi)
4249 dsci_inv=vbld_inv(nres+i)
4250 itypj=iabs(itype(j))
4251 c dscj_inv=dsc_inv(itypj)
4252 dscj_inv=vbld_inv(nres+j)
4256 dxj=dc_norm(1,nres+j)
4257 dyj=dc_norm(2,nres+j)
4258 dzj=dc_norm(3,nres+j)
4259 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4264 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4265 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4266 om12=dxi*dxj+dyi*dyj+dzi*dzj
4268 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4269 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4275 deltat12=om2-om1+2.0d0
4277 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4278 & +akct*deltad*deltat12
4279 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4280 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4281 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4282 c & " deltat12",deltat12," eij",eij
4283 ed=2*akcm*deltad+akct*deltat12
4285 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4286 eom1=-2*akth*deltat1-pom1-om2*pom2
4287 eom2= 2*akth*deltat2+pom1-om1*pom2
4290 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4291 ghpbx(k,i)=ghpbx(k,i)-ggk
4292 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4293 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4294 ghpbx(k,j)=ghpbx(k,j)+ggk
4295 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4296 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4297 ghpbc(k,i)=ghpbc(k,i)-ggk
4298 ghpbc(k,j)=ghpbc(k,j)+ggk
4301 C Calculate the components of the gradient in DC and X
4305 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4310 C--------------------------------------------------------------------------
4311 subroutine ebond(estr)
4313 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4315 implicit real*8 (a-h,o-z)
4316 include 'DIMENSIONS'
4317 include 'COMMON.LOCAL'
4318 include 'COMMON.GEO'
4319 include 'COMMON.INTERACT'
4320 include 'COMMON.DERIV'
4321 include 'COMMON.VAR'
4322 include 'COMMON.CHAIN'
4323 include 'COMMON.IOUNITS'
4324 include 'COMMON.NAMES'
4325 include 'COMMON.FFIELD'
4326 include 'COMMON.CONTROL'
4327 include 'COMMON.SETUP'
4328 double precision u(3),ud(3)
4331 do i=ibondp_start,ibondp_end
4332 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4333 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4335 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4336 & *dc(j,i-1)/vbld(i)
4338 if (energy_dec) write(iout,*)
4339 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4341 diff = vbld(i)-vbldp0
4342 if (energy_dec) write (iout,*)
4343 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4346 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4348 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4351 estr=0.5d0*AKP*estr+estr1
4353 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4355 do i=ibond_start,ibond_end
4357 if (iti.ne.10 .and. iti.ne.ntyp1) then
4360 diff=vbld(i+nres)-vbldsc0(1,iti)
4361 if (energy_dec) write (iout,*)
4362 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4363 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4364 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4366 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4370 diff=vbld(i+nres)-vbldsc0(j,iti)
4371 ud(j)=aksc(j,iti)*diff
4372 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4386 uprod2=uprod2*u(k)*u(k)
4390 usumsqder=usumsqder+ud(j)*uprod2
4392 estr=estr+uprod/usum
4394 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4402 C--------------------------------------------------------------------------
4403 subroutine ebend(etheta)
4405 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4406 C angles gamma and its derivatives in consecutive thetas and gammas.
4408 implicit real*8 (a-h,o-z)
4409 include 'DIMENSIONS'
4410 include 'COMMON.LOCAL'
4411 include 'COMMON.GEO'
4412 include 'COMMON.INTERACT'
4413 include 'COMMON.DERIV'
4414 include 'COMMON.VAR'
4415 include 'COMMON.CHAIN'
4416 include 'COMMON.IOUNITS'
4417 include 'COMMON.NAMES'
4418 include 'COMMON.FFIELD'
4419 include 'COMMON.CONTROL'
4420 common /calcthet/ term1,term2,termm,diffak,ratak,
4421 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4422 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4423 double precision y(2),z(2)
4425 c time11=dexp(-2*time)
4428 c write (*,'(a,i2)') 'EBEND ICG=',icg
4429 do i=ithet_start,ithet_end
4430 if (itype(i-1).eq.ntyp1) cycle
4431 C Zero the energy function and its derivative at 0 or pi.
4432 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4434 ichir1=isign(1,itype(i-2))
4435 ichir2=isign(1,itype(i))
4436 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4437 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4438 if (itype(i-1).eq.10) then
4439 itype1=isign(10,itype(i-2))
4440 ichir11=isign(1,itype(i-2))
4441 ichir12=isign(1,itype(i-2))
4442 itype2=isign(10,itype(i))
4443 ichir21=isign(1,itype(i))
4444 ichir22=isign(1,itype(i))
4447 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4450 if (phii.ne.phii) phii=150.0
4460 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4463 if (phii1.ne.phii1) phii1=150.0
4475 C Calculate the "mean" value of theta from the part of the distribution
4476 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4477 C In following comments this theta will be referred to as t_c.
4478 thet_pred_mean=0.0d0
4480 athetk=athet(k,it,ichir1,ichir2)
4481 bthetk=bthet(k,it,ichir1,ichir2)
4483 athetk=athet(k,itype1,ichir11,ichir12)
4484 bthetk=bthet(k,itype2,ichir21,ichir22)
4486 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4488 dthett=thet_pred_mean*ssd
4489 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4490 C Derivatives of the "mean" values in gamma1 and gamma2.
4491 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4492 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4493 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4494 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4496 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4497 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4498 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4499 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4501 if (theta(i).gt.pi-delta) then
4502 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4504 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4505 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4506 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4508 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4510 else if (theta(i).lt.delta) then
4511 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4512 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4513 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4515 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4516 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4519 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4522 etheta=etheta+ethetai
4523 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4525 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4526 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4527 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4529 C Ufff.... We've done all this!!!
4532 C---------------------------------------------------------------------------
4533 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4535 implicit real*8 (a-h,o-z)
4536 include 'DIMENSIONS'
4537 include 'COMMON.LOCAL'
4538 include 'COMMON.IOUNITS'
4539 common /calcthet/ term1,term2,termm,diffak,ratak,
4540 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4541 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4542 C Calculate the contributions to both Gaussian lobes.
4543 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4544 C The "polynomial part" of the "standard deviation" of this part of
4548 sig=sig*thet_pred_mean+polthet(j,it)
4550 C Derivative of the "interior part" of the "standard deviation of the"
4551 C gamma-dependent Gaussian lobe in t_c.
4552 sigtc=3*polthet(3,it)
4554 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4557 C Set the parameters of both Gaussian lobes of the distribution.
4558 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4559 fac=sig*sig+sigc0(it)
4562 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4563 sigsqtc=-4.0D0*sigcsq*sigtc
4564 c print *,i,sig,sigtc,sigsqtc
4565 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4566 sigtc=-sigtc/(fac*fac)
4567 C Following variable is sigma(t_c)**(-2)
4568 sigcsq=sigcsq*sigcsq
4570 sig0inv=1.0D0/sig0i**2
4571 delthec=thetai-thet_pred_mean
4572 delthe0=thetai-theta0i
4573 term1=-0.5D0*sigcsq*delthec*delthec
4574 term2=-0.5D0*sig0inv*delthe0*delthe0
4575 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4576 C NaNs in taking the logarithm. We extract the largest exponent which is added
4577 C to the energy (this being the log of the distribution) at the end of energy
4578 C term evaluation for this virtual-bond angle.
4579 if (term1.gt.term2) then
4581 term2=dexp(term2-termm)
4585 term1=dexp(term1-termm)
4588 C The ratio between the gamma-independent and gamma-dependent lobes of
4589 C the distribution is a Gaussian function of thet_pred_mean too.
4590 diffak=gthet(2,it)-thet_pred_mean
4591 ratak=diffak/gthet(3,it)**2
4592 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4593 C Let's differentiate it in thet_pred_mean NOW.
4595 C Now put together the distribution terms to make complete distribution.
4596 termexp=term1+ak*term2
4597 termpre=sigc+ak*sig0i
4598 C Contribution of the bending energy from this theta is just the -log of
4599 C the sum of the contributions from the two lobes and the pre-exponential
4600 C factor. Simple enough, isn't it?
4601 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4602 C NOW the derivatives!!!
4603 C 6/6/97 Take into account the deformation.
4604 E_theta=(delthec*sigcsq*term1
4605 & +ak*delthe0*sig0inv*term2)/termexp
4606 E_tc=((sigtc+aktc*sig0i)/termpre
4607 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4608 & aktc*term2)/termexp)
4611 c-----------------------------------------------------------------------------
4612 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4613 implicit real*8 (a-h,o-z)
4614 include 'DIMENSIONS'
4615 include 'COMMON.LOCAL'
4616 include 'COMMON.IOUNITS'
4617 common /calcthet/ term1,term2,termm,diffak,ratak,
4618 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4619 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4620 delthec=thetai-thet_pred_mean
4621 delthe0=thetai-theta0i
4622 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4623 t3 = thetai-thet_pred_mean
4627 t14 = t12+t6*sigsqtc
4629 t21 = thetai-theta0i
4635 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4636 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4637 & *(-t12*t9-ak*sig0inv*t27)
4641 C--------------------------------------------------------------------------
4642 subroutine ebend(etheta)
4644 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4645 C angles gamma and its derivatives in consecutive thetas and gammas.
4646 C ab initio-derived potentials from
4647 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4649 implicit real*8 (a-h,o-z)
4650 include 'DIMENSIONS'
4651 include 'COMMON.LOCAL'
4652 include 'COMMON.GEO'
4653 include 'COMMON.INTERACT'
4654 include 'COMMON.DERIV'
4655 include 'COMMON.VAR'
4656 include 'COMMON.CHAIN'
4657 include 'COMMON.IOUNITS'
4658 include 'COMMON.NAMES'
4659 include 'COMMON.FFIELD'
4660 include 'COMMON.CONTROL'
4661 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4662 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4663 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4664 & sinph1ph2(maxdouble,maxdouble)
4665 logical lprn /.false./, lprn1 /.false./
4667 do i=ithet_start,ithet_end
4668 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4669 &(itype(i).eq.ntyp1)) cycle
4670 C print *,i,theta(i)
4671 if (iabs(itype(i+1)).eq.20) iblock=2
4672 if (iabs(itype(i+1)).ne.20) iblock=1
4676 theti2=0.5d0*theta(i)
4677 ityp2=ithetyp((itype(i-1)))
4679 coskt(k)=dcos(k*theti2)
4680 sinkt(k)=dsin(k*theti2)
4684 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4687 if (phii.ne.phii) phii=150.0
4691 ityp1=ithetyp((itype(i-2)))
4692 C propagation of chirality for glycine type
4694 cosph1(k)=dcos(k*phii)
4695 sinph1(k)=dsin(k*phii)
4700 ityp1=ithetyp((itype(i-2)))
4705 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4708 if (phii1.ne.phii1) phii1=150.0
4713 ityp3=ithetyp((itype(i)))
4715 cosph2(k)=dcos(k*phii1)
4716 sinph2(k)=dsin(k*phii1)
4720 ityp3=ithetyp((itype(i)))
4726 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4729 ccl=cosph1(l)*cosph2(k-l)
4730 ssl=sinph1(l)*sinph2(k-l)
4731 scl=sinph1(l)*cosph2(k-l)
4732 csl=cosph1(l)*sinph2(k-l)
4733 cosph1ph2(l,k)=ccl-ssl
4734 cosph1ph2(k,l)=ccl+ssl
4735 sinph1ph2(l,k)=scl+csl
4736 sinph1ph2(k,l)=scl-csl
4740 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4741 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4742 write (iout,*) "coskt and sinkt"
4744 write (iout,*) k,coskt(k),sinkt(k)
4748 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4749 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4752 & write (iout,*) "k",k,"
4753 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4754 & " ethetai",ethetai
4757 write (iout,*) "cosph and sinph"
4759 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4761 write (iout,*) "cosph1ph2 and sinph2ph2"
4764 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4765 & sinph1ph2(l,k),sinph1ph2(k,l)
4768 write(iout,*) "ethetai",ethetai
4773 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4774 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4775 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4776 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4777 ethetai=ethetai+sinkt(m)*aux
4778 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4779 dephii=dephii+k*sinkt(m)*(
4780 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4781 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4782 dephii1=dephii1+k*sinkt(m)*(
4783 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4784 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4786 & write (iout,*) "m",m," k",k," bbthet",
4787 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4788 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4789 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4790 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4791 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4794 C print *,"cosph1", (cosph1(k), k=1,nsingle)
4795 C print *,"cosph2", (cosph2(k), k=1,nsingle)
4796 C print *,"sinph1", (sinph1(k), k=1,nsingle)
4797 C print *,"sinph2", (sinph2(k), k=1,nsingle)
4799 & write(iout,*) "ethetai",ethetai
4800 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4804 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4805 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4806 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4807 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4808 ethetai=ethetai+sinkt(m)*aux
4809 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4810 dephii=dephii+l*sinkt(m)*(
4811 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4812 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4813 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4814 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4815 dephii1=dephii1+(k-l)*sinkt(m)*(
4816 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4817 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4818 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4819 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4821 write (iout,*) "m",m," k",k," l",l," ffthet",
4822 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4823 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4824 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4825 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4826 & " ethetai",ethetai
4827 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4828 & cosph1ph2(k,l)*sinkt(m),
4829 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4838 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4839 & i,theta(i)*rad2deg,phii*rad2deg,
4840 & phii1*rad2deg,ethetai
4842 etheta=etheta+ethetai
4843 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4844 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4845 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4851 c-----------------------------------------------------------------------------
4852 subroutine esc(escloc)
4853 C Calculate the local energy of a side chain and its derivatives in the
4854 C corresponding virtual-bond valence angles THETA and the spherical angles
4856 implicit real*8 (a-h,o-z)
4857 include 'DIMENSIONS'
4858 include 'COMMON.GEO'
4859 include 'COMMON.LOCAL'
4860 include 'COMMON.VAR'
4861 include 'COMMON.INTERACT'
4862 include 'COMMON.DERIV'
4863 include 'COMMON.CHAIN'
4864 include 'COMMON.IOUNITS'
4865 include 'COMMON.NAMES'
4866 include 'COMMON.FFIELD'
4867 include 'COMMON.CONTROL'
4868 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4869 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4870 common /sccalc/ time11,time12,time112,theti,it,nlobit
4873 c write (iout,'(a)') 'ESC'
4874 do i=loc_start,loc_end
4876 if (it.eq.ntyp1) cycle
4877 if (it.eq.10) goto 1
4878 nlobit=nlob(iabs(it))
4879 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4880 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4881 theti=theta(i+1)-pipol
4886 if (x(2).gt.pi-delta) then
4890 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4892 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4893 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4895 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4896 & ddersc0(1),dersc(1))
4897 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4898 & ddersc0(3),dersc(3))
4900 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4902 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4903 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4904 & dersc0(2),esclocbi,dersc02)
4905 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4907 call splinthet(x(2),0.5d0*delta,ss,ssd)
4912 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4914 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4915 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4917 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4919 c write (iout,*) escloci
4920 else if (x(2).lt.delta) then
4924 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4926 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4927 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4929 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4930 & ddersc0(1),dersc(1))
4931 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4932 & ddersc0(3),dersc(3))
4934 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4936 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4937 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4938 & dersc0(2),esclocbi,dersc02)
4939 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4944 call splinthet(x(2),0.5d0*delta,ss,ssd)
4946 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4948 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4949 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4951 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4952 c write (iout,*) escloci
4954 call enesc(x,escloci,dersc,ddummy,.false.)
4957 escloc=escloc+escloci
4958 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4959 & 'escloc',i,escloci
4960 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4962 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4964 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4965 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4970 C---------------------------------------------------------------------------
4971 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4972 implicit real*8 (a-h,o-z)
4973 include 'DIMENSIONS'
4974 include 'COMMON.GEO'
4975 include 'COMMON.LOCAL'
4976 include 'COMMON.IOUNITS'
4977 common /sccalc/ time11,time12,time112,theti,it,nlobit
4978 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4979 double precision contr(maxlob,-1:1)
4981 c write (iout,*) 'it=',it,' nlobit=',nlobit
4985 if (mixed) ddersc(j)=0.0d0
4989 C Because of periodicity of the dependence of the SC energy in omega we have
4990 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4991 C To avoid underflows, first compute & store the exponents.
4999 z(k)=x(k)-censc(k,j,it)
5004 Axk=Axk+gaussc(l,k,j,it)*z(l)
5010 expfac=expfac+Ax(k,j,iii)*z(k)
5018 C As in the case of ebend, we want to avoid underflows in exponentiation and
5019 C subsequent NaNs and INFs in energy calculation.
5020 C Find the largest exponent
5024 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5028 cd print *,'it=',it,' emin=',emin
5030 C Compute the contribution to SC energy and derivatives
5035 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5036 if(adexp.ne.adexp) adexp=1.0
5039 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5041 cd print *,'j=',j,' expfac=',expfac
5042 escloc_i=escloc_i+expfac
5044 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5048 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5049 & +gaussc(k,2,j,it))*expfac
5056 dersc(1)=dersc(1)/cos(theti)**2
5057 ddersc(1)=ddersc(1)/cos(theti)**2
5060 escloci=-(dlog(escloc_i)-emin)
5062 dersc(j)=dersc(j)/escloc_i
5066 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5071 C------------------------------------------------------------------------------
5072 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5073 implicit real*8 (a-h,o-z)
5074 include 'DIMENSIONS'
5075 include 'COMMON.GEO'
5076 include 'COMMON.LOCAL'
5077 include 'COMMON.IOUNITS'
5078 common /sccalc/ time11,time12,time112,theti,it,nlobit
5079 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5080 double precision contr(maxlob)
5091 z(k)=x(k)-censc(k,j,it)
5097 Axk=Axk+gaussc(l,k,j,it)*z(l)
5103 expfac=expfac+Ax(k,j)*z(k)
5108 C As in the case of ebend, we want to avoid underflows in exponentiation and
5109 C subsequent NaNs and INFs in energy calculation.
5110 C Find the largest exponent
5113 if (emin.gt.contr(j)) emin=contr(j)
5117 C Compute the contribution to SC energy and derivatives
5121 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5122 escloc_i=escloc_i+expfac
5124 dersc(k)=dersc(k)+Ax(k,j)*expfac
5126 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5127 & +gaussc(1,2,j,it))*expfac
5131 dersc(1)=dersc(1)/cos(theti)**2
5132 dersc12=dersc12/cos(theti)**2
5133 escloci=-(dlog(escloc_i)-emin)
5135 dersc(j)=dersc(j)/escloc_i
5137 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5141 c----------------------------------------------------------------------------------
5142 subroutine esc(escloc)
5143 C Calculate the local energy of a side chain and its derivatives in the
5144 C corresponding virtual-bond valence angles THETA and the spherical angles
5145 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5146 C added by Urszula Kozlowska. 07/11/2007
5148 implicit real*8 (a-h,o-z)
5149 include 'DIMENSIONS'
5150 include 'COMMON.GEO'
5151 include 'COMMON.LOCAL'
5152 include 'COMMON.VAR'
5153 include 'COMMON.SCROT'
5154 include 'COMMON.INTERACT'
5155 include 'COMMON.DERIV'
5156 include 'COMMON.CHAIN'
5157 include 'COMMON.IOUNITS'
5158 include 'COMMON.NAMES'
5159 include 'COMMON.FFIELD'
5160 include 'COMMON.CONTROL'
5161 include 'COMMON.VECTORS'
5162 double precision x_prime(3),y_prime(3),z_prime(3)
5163 & , sumene,dsc_i,dp2_i,x(65),
5164 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5165 & de_dxx,de_dyy,de_dzz,de_dt
5166 double precision s1_t,s1_6_t,s2_t,s2_6_t
5168 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5169 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5170 & dt_dCi(3),dt_dCi1(3)
5171 common /sccalc/ time11,time12,time112,theti,it,nlobit
5174 do i=loc_start,loc_end
5175 if (itype(i).eq.ntyp1) cycle
5176 costtab(i+1) =dcos(theta(i+1))
5177 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5178 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5179 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5180 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5181 cosfac=dsqrt(cosfac2)
5182 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5183 sinfac=dsqrt(sinfac2)
5185 if (it.eq.10) goto 1
5187 C Compute the axes of tghe local cartesian coordinates system; store in
5188 c x_prime, y_prime and z_prime
5195 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5196 C & dc_norm(3,i+nres)
5198 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5199 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5202 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5205 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5206 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5207 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5208 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5209 c & " xy",scalar(x_prime(1),y_prime(1)),
5210 c & " xz",scalar(x_prime(1),z_prime(1)),
5211 c & " yy",scalar(y_prime(1),y_prime(1)),
5212 c & " yz",scalar(y_prime(1),z_prime(1)),
5213 c & " zz",scalar(z_prime(1),z_prime(1))
5215 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5216 C to local coordinate system. Store in xx, yy, zz.
5222 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5223 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5224 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5231 C Compute the energy of the ith side cbain
5233 c write (2,*) "xx",xx," yy",yy," zz",zz
5236 x(j) = sc_parmin(j,it)
5239 Cc diagnostics - remove later
5241 yy1 = dsin(alph(2))*dcos(omeg(2))
5242 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5243 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5244 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5246 C," --- ", xx_w,yy_w,zz_w
5249 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5250 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5252 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5253 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5255 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5256 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5257 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5258 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5259 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5261 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5262 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5263 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5264 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5265 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5267 dsc_i = 0.743d0+x(61)
5269 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5270 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5271 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5272 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5273 s1=(1+x(63))/(0.1d0 + dscp1)
5274 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5275 s2=(1+x(65))/(0.1d0 + dscp2)
5276 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5277 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5278 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5279 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5281 c & dscp1,dscp2,sumene
5282 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5283 escloc = escloc + sumene
5284 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5289 C This section to check the numerical derivatives of the energy of ith side
5290 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5291 C #define DEBUG in the code to turn it on.
5293 write (2,*) "sumene =",sumene
5297 write (2,*) xx,yy,zz
5298 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5299 de_dxx_num=(sumenep-sumene)/aincr
5301 write (2,*) "xx+ sumene from enesc=",sumenep
5304 write (2,*) xx,yy,zz
5305 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5306 de_dyy_num=(sumenep-sumene)/aincr
5308 write (2,*) "yy+ sumene from enesc=",sumenep
5311 write (2,*) xx,yy,zz
5312 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5313 de_dzz_num=(sumenep-sumene)/aincr
5315 write (2,*) "zz+ sumene from enesc=",sumenep
5316 costsave=cost2tab(i+1)
5317 sintsave=sint2tab(i+1)
5318 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5319 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5320 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5321 de_dt_num=(sumenep-sumene)/aincr
5322 write (2,*) " t+ sumene from enesc=",sumenep
5323 cost2tab(i+1)=costsave
5324 sint2tab(i+1)=sintsave
5325 C End of diagnostics section.
5328 C Compute the gradient of esc
5330 c zz=zz*dsign(1.0,dfloat(itype(i)))
5331 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5332 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5333 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5334 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5335 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5336 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5337 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5338 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5339 pom1=(sumene3*sint2tab(i+1)+sumene1)
5340 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5341 pom2=(sumene4*cost2tab(i+1)+sumene2)
5342 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5343 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5344 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5345 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5347 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5348 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5349 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5351 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5352 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5353 & +(pom1+pom2)*pom_dx
5355 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5358 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5359 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5360 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5362 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5363 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5364 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5365 & +x(59)*zz**2 +x(60)*xx*zz
5366 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5367 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5368 & +(pom1-pom2)*pom_dy
5370 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5373 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5374 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5375 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5376 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5377 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5378 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5379 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5380 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5382 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5385 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5386 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5387 & +pom1*pom_dt1+pom2*pom_dt2
5389 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5394 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5395 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5396 cosfac2xx=cosfac2*xx
5397 sinfac2yy=sinfac2*yy
5399 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5401 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5403 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5404 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5405 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5406 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5407 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5408 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5409 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5410 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5411 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5412 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5416 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5417 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5418 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5419 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5422 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5423 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5424 dZZ_XYZ(k)=vbld_inv(i+nres)*
5425 & (z_prime(k)-zz*dC_norm(k,i+nres))
5427 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5428 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5432 dXX_Ctab(k,i)=dXX_Ci(k)
5433 dXX_C1tab(k,i)=dXX_Ci1(k)
5434 dYY_Ctab(k,i)=dYY_Ci(k)
5435 dYY_C1tab(k,i)=dYY_Ci1(k)
5436 dZZ_Ctab(k,i)=dZZ_Ci(k)
5437 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5438 dXX_XYZtab(k,i)=dXX_XYZ(k)
5439 dYY_XYZtab(k,i)=dYY_XYZ(k)
5440 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5444 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5445 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5446 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5447 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5448 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5450 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5451 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5452 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5453 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5454 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5455 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5456 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5457 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5459 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5460 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5462 C to check gradient call subroutine check_grad
5468 c------------------------------------------------------------------------------
5469 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5471 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5472 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5473 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5474 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5476 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5477 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5479 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5480 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5481 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5482 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5483 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5485 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5486 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5487 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5488 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5489 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5491 dsc_i = 0.743d0+x(61)
5493 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5494 & *(xx*cost2+yy*sint2))
5495 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5496 & *(xx*cost2-yy*sint2))
5497 s1=(1+x(63))/(0.1d0 + dscp1)
5498 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5499 s2=(1+x(65))/(0.1d0 + dscp2)
5500 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5501 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5502 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5507 c------------------------------------------------------------------------------
5508 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5510 C This procedure calculates two-body contact function g(rij) and its derivative:
5513 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5516 C where x=(rij-r0ij)/delta
5518 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5521 double precision rij,r0ij,eps0ij,fcont,fprimcont
5522 double precision x,x2,x4,delta
5526 if (x.lt.-1.0D0) then
5529 else if (x.le.1.0D0) then
5532 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5533 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5540 c------------------------------------------------------------------------------
5541 subroutine splinthet(theti,delta,ss,ssder)
5542 implicit real*8 (a-h,o-z)
5543 include 'DIMENSIONS'
5544 include 'COMMON.VAR'
5545 include 'COMMON.GEO'
5548 if (theti.gt.pipol) then
5549 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5551 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5556 c------------------------------------------------------------------------------
5557 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5559 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5560 double precision ksi,ksi2,ksi3,a1,a2,a3
5561 a1=fprim0*delta/(f1-f0)
5567 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5568 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5571 c------------------------------------------------------------------------------
5572 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5574 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5575 double precision ksi,ksi2,ksi3,a1,a2,a3
5580 a2=3*(f1x-f0x)-2*fprim0x*delta
5581 a3=fprim0x*delta-2*(f1x-f0x)
5582 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5585 C-----------------------------------------------------------------------------
5587 C-----------------------------------------------------------------------------
5588 subroutine etor(etors,edihcnstr)
5589 implicit real*8 (a-h,o-z)
5590 include 'DIMENSIONS'
5591 include 'COMMON.VAR'
5592 include 'COMMON.GEO'
5593 include 'COMMON.LOCAL'
5594 include 'COMMON.TORSION'
5595 include 'COMMON.INTERACT'
5596 include 'COMMON.DERIV'
5597 include 'COMMON.CHAIN'
5598 include 'COMMON.NAMES'
5599 include 'COMMON.IOUNITS'
5600 include 'COMMON.FFIELD'
5601 include 'COMMON.TORCNSTR'
5602 include 'COMMON.CONTROL'
5604 C Set lprn=.true. for debugging
5608 do i=iphi_start,iphi_end
5610 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5611 & .or. itype(i).eq.ntyp1) cycle
5612 itori=itortyp(itype(i-2))
5613 itori1=itortyp(itype(i-1))
5616 C Proline-Proline pair is a special case...
5617 if (itori.eq.3 .and. itori1.eq.3) then
5618 if (phii.gt.-dwapi3) then
5620 fac=1.0D0/(1.0D0-cosphi)
5621 etorsi=v1(1,3,3)*fac
5622 etorsi=etorsi+etorsi
5623 etors=etors+etorsi-v1(1,3,3)
5624 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5625 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5628 v1ij=v1(j+1,itori,itori1)
5629 v2ij=v2(j+1,itori,itori1)
5632 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5633 if (energy_dec) etors_ii=etors_ii+
5634 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5635 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5639 v1ij=v1(j,itori,itori1)
5640 v2ij=v2(j,itori,itori1)
5643 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5644 if (energy_dec) etors_ii=etors_ii+
5645 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5646 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5649 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5652 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5653 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5654 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5655 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5656 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5658 ! 6/20/98 - dihedral angle constraints
5661 itori=idih_constr(i)
5664 if (difi.gt.drange(i)) then
5666 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5667 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5668 else if (difi.lt.-drange(i)) then
5670 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5671 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5673 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5674 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5676 ! write (iout,*) 'edihcnstr',edihcnstr
5679 c------------------------------------------------------------------------------
5680 subroutine etor_d(etors_d)
5684 c----------------------------------------------------------------------------
5686 subroutine etor(etors,edihcnstr)
5687 implicit real*8 (a-h,o-z)
5688 include 'DIMENSIONS'
5689 include 'COMMON.VAR'
5690 include 'COMMON.GEO'
5691 include 'COMMON.LOCAL'
5692 include 'COMMON.TORSION'
5693 include 'COMMON.INTERACT'
5694 include 'COMMON.DERIV'
5695 include 'COMMON.CHAIN'
5696 include 'COMMON.NAMES'
5697 include 'COMMON.IOUNITS'
5698 include 'COMMON.FFIELD'
5699 include 'COMMON.TORCNSTR'
5700 include 'COMMON.CONTROL'
5702 C Set lprn=.true. for debugging
5706 do i=iphi_start,iphi_end
5707 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5708 & .or. itype(i).eq.ntyp1) cycle
5710 if (iabs(itype(i)).eq.20) then
5715 itori=itortyp(itype(i-2))
5716 itori1=itortyp(itype(i-1))
5719 C Regular cosine and sine terms
5720 do j=1,nterm(itori,itori1,iblock)
5721 v1ij=v1(j,itori,itori1,iblock)
5722 v2ij=v2(j,itori,itori1,iblock)
5725 etors=etors+v1ij*cosphi+v2ij*sinphi
5726 if (energy_dec) etors_ii=etors_ii+
5727 & v1ij*cosphi+v2ij*sinphi
5728 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5732 C E = SUM ----------------------------------- - v1
5733 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5735 cosphi=dcos(0.5d0*phii)
5736 sinphi=dsin(0.5d0*phii)
5737 do j=1,nlor(itori,itori1,iblock)
5738 vl1ij=vlor1(j,itori,itori1)
5739 vl2ij=vlor2(j,itori,itori1)
5740 vl3ij=vlor3(j,itori,itori1)
5741 pom=vl2ij*cosphi+vl3ij*sinphi
5742 pom1=1.0d0/(pom*pom+1.0d0)
5743 etors=etors+vl1ij*pom1
5744 if (energy_dec) etors_ii=etors_ii+
5747 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5749 C Subtract the constant term
5750 etors=etors-v0(itori,itori1,iblock)
5751 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5752 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5754 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5755 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5756 & (v1(j,itori,itori1,iblock),j=1,6),
5757 & (v2(j,itori,itori1,iblock),j=1,6)
5758 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5759 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5761 ! 6/20/98 - dihedral angle constraints
5763 c do i=1,ndih_constr
5764 do i=idihconstr_start,idihconstr_end
5765 itori=idih_constr(i)
5767 difi=pinorm(phii-phi0(i))
5768 if (difi.gt.drange(i)) then
5770 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5771 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5772 else if (difi.lt.-drange(i)) then
5774 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5775 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5779 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5780 cd & rad2deg*phi0(i), rad2deg*drange(i),
5781 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5783 cd write (iout,*) 'edihcnstr',edihcnstr
5786 c----------------------------------------------------------------------------
5787 subroutine etor_d(etors_d)
5788 C 6/23/01 Compute double torsional energy
5789 implicit real*8 (a-h,o-z)
5790 include 'DIMENSIONS'
5791 include 'COMMON.VAR'
5792 include 'COMMON.GEO'
5793 include 'COMMON.LOCAL'
5794 include 'COMMON.TORSION'
5795 include 'COMMON.INTERACT'
5796 include 'COMMON.DERIV'
5797 include 'COMMON.CHAIN'
5798 include 'COMMON.NAMES'
5799 include 'COMMON.IOUNITS'
5800 include 'COMMON.FFIELD'
5801 include 'COMMON.TORCNSTR'
5803 C Set lprn=.true. for debugging
5807 c write(iout,*) "a tu??"
5808 do i=iphid_start,iphid_end
5809 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5810 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5811 itori=itortyp(itype(i-2))
5812 itori1=itortyp(itype(i-1))
5813 itori2=itortyp(itype(i))
5819 if (iabs(itype(i+1)).eq.20) iblock=2
5821 C Regular cosine and sine terms
5822 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5823 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5824 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5825 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5826 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5827 cosphi1=dcos(j*phii)
5828 sinphi1=dsin(j*phii)
5829 cosphi2=dcos(j*phii1)
5830 sinphi2=dsin(j*phii1)
5831 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5832 & v2cij*cosphi2+v2sij*sinphi2
5833 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5834 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5836 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5838 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5839 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5840 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5841 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5842 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5843 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5844 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5845 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5846 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5847 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5848 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5849 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5850 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5851 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5854 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5855 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5860 c------------------------------------------------------------------------------
5861 subroutine eback_sc_corr(esccor)
5862 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5863 c conformational states; temporarily implemented as differences
5864 c between UNRES torsional potentials (dependent on three types of
5865 c residues) and the torsional potentials dependent on all 20 types
5866 c of residues computed from AM1 energy surfaces of terminally-blocked
5867 c amino-acid residues.
5868 implicit real*8 (a-h,o-z)
5869 include 'DIMENSIONS'
5870 include 'COMMON.VAR'
5871 include 'COMMON.GEO'
5872 include 'COMMON.LOCAL'
5873 include 'COMMON.TORSION'
5874 include 'COMMON.SCCOR'
5875 include 'COMMON.INTERACT'
5876 include 'COMMON.DERIV'
5877 include 'COMMON.CHAIN'
5878 include 'COMMON.NAMES'
5879 include 'COMMON.IOUNITS'
5880 include 'COMMON.FFIELD'
5881 include 'COMMON.CONTROL'
5883 C Set lprn=.true. for debugging
5886 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5888 do i=itau_start,itau_end
5889 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5891 isccori=isccortyp(itype(i-2))
5892 isccori1=isccortyp(itype(i-1))
5893 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5895 do intertyp=1,3 !intertyp
5896 cc Added 09 May 2012 (Adasko)
5897 cc Intertyp means interaction type of backbone mainchain correlation:
5898 c 1 = SC...Ca...Ca...Ca
5899 c 2 = Ca...Ca...Ca...SC
5900 c 3 = SC...Ca...Ca...SCi
5902 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5903 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5904 & (itype(i-1).eq.ntyp1)))
5905 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5906 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5907 & .or.(itype(i).eq.ntyp1)))
5908 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5909 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5910 & (itype(i-3).eq.ntyp1)))) cycle
5911 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5912 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5914 do j=1,nterm_sccor(isccori,isccori1)
5915 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5916 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5917 cosphi=dcos(j*tauangle(intertyp,i))
5918 sinphi=dsin(j*tauangle(intertyp,i))
5919 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5920 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5922 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5923 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5925 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5926 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
5927 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
5928 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5929 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5935 c----------------------------------------------------------------------------
5936 subroutine multibody(ecorr)
5937 C This subroutine calculates multi-body contributions to energy following
5938 C the idea of Skolnick et al. If side chains I and J make a contact and
5939 C at the same time side chains I+1 and J+1 make a contact, an extra
5940 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5941 implicit real*8 (a-h,o-z)
5942 include 'DIMENSIONS'
5943 include 'COMMON.IOUNITS'
5944 include 'COMMON.DERIV'
5945 include 'COMMON.INTERACT'
5946 include 'COMMON.CONTACTS'
5947 double precision gx(3),gx1(3)
5950 C Set lprn=.true. for debugging
5954 write (iout,'(a)') 'Contact function values:'
5956 write (iout,'(i2,20(1x,i2,f10.5))')
5957 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5972 num_conti=num_cont(i)
5973 num_conti1=num_cont(i1)
5978 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5979 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5980 cd & ' ishift=',ishift
5981 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5982 C The system gains extra energy.
5983 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5984 endif ! j1==j+-ishift
5993 c------------------------------------------------------------------------------
5994 double precision function esccorr(i,j,k,l,jj,kk)
5995 implicit real*8 (a-h,o-z)
5996 include 'DIMENSIONS'
5997 include 'COMMON.IOUNITS'
5998 include 'COMMON.DERIV'
5999 include 'COMMON.INTERACT'
6000 include 'COMMON.CONTACTS'
6001 double precision gx(3),gx1(3)
6006 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6007 C Calculate the multi-body contribution to energy.
6008 C Calculate multi-body contributions to the gradient.
6009 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6010 cd & k,l,(gacont(m,kk,k),m=1,3)
6012 gx(m) =ekl*gacont(m,jj,i)
6013 gx1(m)=eij*gacont(m,kk,k)
6014 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6015 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6016 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6017 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6021 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6026 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6032 c------------------------------------------------------------------------------
6033 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6034 C This subroutine calculates multi-body contributions to hydrogen-bonding
6035 implicit real*8 (a-h,o-z)
6036 include 'DIMENSIONS'
6037 include 'COMMON.IOUNITS'
6040 parameter (max_cont=maxconts)
6041 parameter (max_dim=26)
6042 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6043 double precision zapas(max_dim,maxconts,max_fg_procs),
6044 & zapas_recv(max_dim,maxconts,max_fg_procs)
6045 common /przechowalnia/ zapas
6046 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6047 & status_array(MPI_STATUS_SIZE,maxconts*2)
6049 include 'COMMON.SETUP'
6050 include 'COMMON.FFIELD'
6051 include 'COMMON.DERIV'
6052 include 'COMMON.INTERACT'
6053 include 'COMMON.CONTACTS'
6054 include 'COMMON.CONTROL'
6055 include 'COMMON.LOCAL'
6056 double precision gx(3),gx1(3),time00
6059 C Set lprn=.true. for debugging
6064 if (nfgtasks.le.1) goto 30
6066 write (iout,'(a)') 'Contact function values before RECEIVE:'
6068 write (iout,'(2i3,50(1x,i2,f5.2))')
6069 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6070 & j=1,num_cont_hb(i))
6074 do i=1,ntask_cont_from
6077 do i=1,ntask_cont_to
6080 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6082 C Make the list of contacts to send to send to other procesors
6083 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6085 do i=iturn3_start,iturn3_end
6086 c write (iout,*) "make contact list turn3",i," num_cont",
6088 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6090 do i=iturn4_start,iturn4_end
6091 c write (iout,*) "make contact list turn4",i," num_cont",
6093 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6097 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6099 do j=1,num_cont_hb(i)
6102 iproc=iint_sent_local(k,jjc,ii)
6103 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6104 if (iproc.gt.0) then
6105 ncont_sent(iproc)=ncont_sent(iproc)+1
6106 nn=ncont_sent(iproc)
6108 zapas(2,nn,iproc)=jjc
6109 zapas(3,nn,iproc)=facont_hb(j,i)
6110 zapas(4,nn,iproc)=ees0p(j,i)
6111 zapas(5,nn,iproc)=ees0m(j,i)
6112 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6113 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6114 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6115 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6116 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6117 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6118 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6119 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6120 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6121 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6122 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6123 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6124 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6125 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6126 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6127 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6128 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6129 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6130 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6131 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6132 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6139 & "Numbers of contacts to be sent to other processors",
6140 & (ncont_sent(i),i=1,ntask_cont_to)
6141 write (iout,*) "Contacts sent"
6142 do ii=1,ntask_cont_to
6144 iproc=itask_cont_to(ii)
6145 write (iout,*) nn," contacts to processor",iproc,
6146 & " of CONT_TO_COMM group"
6148 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6156 CorrelID1=nfgtasks+fg_rank+1
6158 C Receive the numbers of needed contacts from other processors
6159 do ii=1,ntask_cont_from
6160 iproc=itask_cont_from(ii)
6162 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6163 & FG_COMM,req(ireq),IERR)
6165 c write (iout,*) "IRECV ended"
6167 C Send the number of contacts needed by other processors
6168 do ii=1,ntask_cont_to
6169 iproc=itask_cont_to(ii)
6171 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6172 & FG_COMM,req(ireq),IERR)
6174 c write (iout,*) "ISEND ended"
6175 c write (iout,*) "number of requests (nn)",ireq
6178 & call MPI_Waitall(ireq,req,status_array,ierr)
6180 c & "Numbers of contacts to be received from other processors",
6181 c & (ncont_recv(i),i=1,ntask_cont_from)
6185 do ii=1,ntask_cont_from
6186 iproc=itask_cont_from(ii)
6188 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6189 c & " of CONT_TO_COMM group"
6193 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6194 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6195 c write (iout,*) "ireq,req",ireq,req(ireq)
6198 C Send the contacts to processors that need them
6199 do ii=1,ntask_cont_to
6200 iproc=itask_cont_to(ii)
6202 c write (iout,*) nn," contacts to processor",iproc,
6203 c & " of CONT_TO_COMM group"
6206 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6207 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6208 c write (iout,*) "ireq,req",ireq,req(ireq)
6210 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6214 c write (iout,*) "number of requests (contacts)",ireq
6215 c write (iout,*) "req",(req(i),i=1,4)
6218 & call MPI_Waitall(ireq,req,status_array,ierr)
6219 do iii=1,ntask_cont_from
6220 iproc=itask_cont_from(iii)
6223 write (iout,*) "Received",nn," contacts from processor",iproc,
6224 & " of CONT_FROM_COMM group"
6227 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6232 ii=zapas_recv(1,i,iii)
6233 c Flag the received contacts to prevent double-counting
6234 jj=-zapas_recv(2,i,iii)
6235 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6237 nnn=num_cont_hb(ii)+1
6240 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6241 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6242 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6243 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6244 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6245 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6246 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6247 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6248 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6249 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6250 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6251 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6252 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6253 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6254 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6255 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6256 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6257 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6258 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6259 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6260 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6261 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6262 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6263 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6268 write (iout,'(a)') 'Contact function values after receive:'
6270 write (iout,'(2i3,50(1x,i3,f5.2))')
6271 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6272 & j=1,num_cont_hb(i))
6279 write (iout,'(a)') 'Contact function values:'
6281 write (iout,'(2i3,50(1x,i3,f5.2))')
6282 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6283 & j=1,num_cont_hb(i))
6287 C Remove the loop below after debugging !!!
6294 C Calculate the local-electrostatic correlation terms
6295 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6297 num_conti=num_cont_hb(i)
6298 num_conti1=num_cont_hb(i+1)
6305 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6306 c & ' jj=',jj,' kk=',kk
6307 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6308 & .or. j.lt.0 .and. j1.gt.0) .and.
6309 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6310 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6311 C The system gains extra energy.
6312 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6313 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6314 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6316 else if (j1.eq.j) then
6317 C Contacts I-J and I-(J+1) occur simultaneously.
6318 C The system loses extra energy.
6319 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6324 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6325 c & ' jj=',jj,' kk=',kk
6327 C Contacts I-J and (I+1)-J occur simultaneously.
6328 C The system loses extra energy.
6329 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6336 c------------------------------------------------------------------------------
6337 subroutine add_hb_contact(ii,jj,itask)
6338 implicit real*8 (a-h,o-z)
6339 include "DIMENSIONS"
6340 include "COMMON.IOUNITS"
6343 parameter (max_cont=maxconts)
6344 parameter (max_dim=26)
6345 include "COMMON.CONTACTS"
6346 double precision zapas(max_dim,maxconts,max_fg_procs),
6347 & zapas_recv(max_dim,maxconts,max_fg_procs)
6348 common /przechowalnia/ zapas
6349 integer i,j,ii,jj,iproc,itask(4),nn
6350 c write (iout,*) "itask",itask
6353 if (iproc.gt.0) then
6354 do j=1,num_cont_hb(ii)
6356 c write (iout,*) "i",ii," j",jj," jjc",jjc
6358 ncont_sent(iproc)=ncont_sent(iproc)+1
6359 nn=ncont_sent(iproc)
6360 zapas(1,nn,iproc)=ii
6361 zapas(2,nn,iproc)=jjc
6362 zapas(3,nn,iproc)=facont_hb(j,ii)
6363 zapas(4,nn,iproc)=ees0p(j,ii)
6364 zapas(5,nn,iproc)=ees0m(j,ii)
6365 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6366 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6367 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6368 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6369 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6370 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6371 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6372 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6373 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6374 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6375 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6376 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6377 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6378 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6379 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6380 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6381 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6382 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6383 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6384 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6385 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6393 c------------------------------------------------------------------------------
6394 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6396 C This subroutine calculates multi-body contributions to hydrogen-bonding
6397 implicit real*8 (a-h,o-z)
6398 include 'DIMENSIONS'
6399 include 'COMMON.IOUNITS'
6402 parameter (max_cont=maxconts)
6403 parameter (max_dim=70)
6404 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6405 double precision zapas(max_dim,maxconts,max_fg_procs),
6406 & zapas_recv(max_dim,maxconts,max_fg_procs)
6407 common /przechowalnia/ zapas
6408 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6409 & status_array(MPI_STATUS_SIZE,maxconts*2)
6411 include 'COMMON.SETUP'
6412 include 'COMMON.FFIELD'
6413 include 'COMMON.DERIV'
6414 include 'COMMON.LOCAL'
6415 include 'COMMON.INTERACT'
6416 include 'COMMON.CONTACTS'
6417 include 'COMMON.CHAIN'
6418 include 'COMMON.CONTROL'
6419 double precision gx(3),gx1(3)
6420 integer num_cont_hb_old(maxres)
6422 double precision eello4,eello5,eelo6,eello_turn6
6423 external eello4,eello5,eello6,eello_turn6
6424 C Set lprn=.true. for debugging
6429 num_cont_hb_old(i)=num_cont_hb(i)
6433 if (nfgtasks.le.1) goto 30
6435 write (iout,'(a)') 'Contact function values before RECEIVE:'
6437 write (iout,'(2i3,50(1x,i2,f5.2))')
6438 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6439 & j=1,num_cont_hb(i))
6443 do i=1,ntask_cont_from
6446 do i=1,ntask_cont_to
6449 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6451 C Make the list of contacts to send to send to other procesors
6452 do i=iturn3_start,iturn3_end
6453 c write (iout,*) "make contact list turn3",i," num_cont",
6455 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6457 do i=iturn4_start,iturn4_end
6458 c write (iout,*) "make contact list turn4",i," num_cont",
6460 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6464 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6466 do j=1,num_cont_hb(i)
6469 iproc=iint_sent_local(k,jjc,ii)
6470 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6471 if (iproc.ne.0) then
6472 ncont_sent(iproc)=ncont_sent(iproc)+1
6473 nn=ncont_sent(iproc)
6475 zapas(2,nn,iproc)=jjc
6476 zapas(3,nn,iproc)=d_cont(j,i)
6480 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6485 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6493 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6504 & "Numbers of contacts to be sent to other processors",
6505 & (ncont_sent(i),i=1,ntask_cont_to)
6506 write (iout,*) "Contacts sent"
6507 do ii=1,ntask_cont_to
6509 iproc=itask_cont_to(ii)
6510 write (iout,*) nn," contacts to processor",iproc,
6511 & " of CONT_TO_COMM group"
6513 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6521 CorrelID1=nfgtasks+fg_rank+1
6523 C Receive the numbers of needed contacts from other processors
6524 do ii=1,ntask_cont_from
6525 iproc=itask_cont_from(ii)
6527 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6528 & FG_COMM,req(ireq),IERR)
6530 c write (iout,*) "IRECV ended"
6532 C Send the number of contacts needed by other processors
6533 do ii=1,ntask_cont_to
6534 iproc=itask_cont_to(ii)
6536 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6537 & FG_COMM,req(ireq),IERR)
6539 c write (iout,*) "ISEND ended"
6540 c write (iout,*) "number of requests (nn)",ireq
6543 & call MPI_Waitall(ireq,req,status_array,ierr)
6545 c & "Numbers of contacts to be received from other processors",
6546 c & (ncont_recv(i),i=1,ntask_cont_from)
6550 do ii=1,ntask_cont_from
6551 iproc=itask_cont_from(ii)
6553 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6554 c & " of CONT_TO_COMM group"
6558 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6559 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6560 c write (iout,*) "ireq,req",ireq,req(ireq)
6563 C Send the contacts to processors that need them
6564 do ii=1,ntask_cont_to
6565 iproc=itask_cont_to(ii)
6567 c write (iout,*) nn," contacts to processor",iproc,
6568 c & " of CONT_TO_COMM group"
6571 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6572 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6573 c write (iout,*) "ireq,req",ireq,req(ireq)
6575 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6579 c write (iout,*) "number of requests (contacts)",ireq
6580 c write (iout,*) "req",(req(i),i=1,4)
6583 & call MPI_Waitall(ireq,req,status_array,ierr)
6584 do iii=1,ntask_cont_from
6585 iproc=itask_cont_from(iii)
6588 write (iout,*) "Received",nn," contacts from processor",iproc,
6589 & " of CONT_FROM_COMM group"
6592 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6597 ii=zapas_recv(1,i,iii)
6598 c Flag the received contacts to prevent double-counting
6599 jj=-zapas_recv(2,i,iii)
6600 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6602 nnn=num_cont_hb(ii)+1
6605 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6609 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6614 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6622 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6631 write (iout,'(a)') 'Contact function values after receive:'
6633 write (iout,'(2i3,50(1x,i3,5f6.3))')
6634 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6635 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6642 write (iout,'(a)') 'Contact function values:'
6644 write (iout,'(2i3,50(1x,i2,5f6.3))')
6645 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6646 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6652 C Remove the loop below after debugging !!!
6659 C Calculate the dipole-dipole interaction energies
6660 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6661 do i=iatel_s,iatel_e+1
6662 num_conti=num_cont_hb(i)
6671 C Calculate the local-electrostatic correlation terms
6672 c write (iout,*) "gradcorr5 in eello5 before loop"
6674 c write (iout,'(i5,3f10.5)')
6675 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6677 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6678 c write (iout,*) "corr loop i",i
6680 num_conti=num_cont_hb(i)
6681 num_conti1=num_cont_hb(i+1)
6688 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6689 c & ' jj=',jj,' kk=',kk
6690 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6691 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6692 & .or. j.lt.0 .and. j1.gt.0) .and.
6693 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6694 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6695 C The system gains extra energy.
6697 sqd1=dsqrt(d_cont(jj,i))
6698 sqd2=dsqrt(d_cont(kk,i1))
6699 sred_geom = sqd1*sqd2
6700 IF (sred_geom.lt.cutoff_corr) THEN
6701 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6703 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6704 cd & ' jj=',jj,' kk=',kk
6705 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6706 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6708 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6709 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6712 cd write (iout,*) 'sred_geom=',sred_geom,
6713 cd & ' ekont=',ekont,' fprim=',fprimcont,
6714 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6715 cd write (iout,*) "g_contij",g_contij
6716 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6717 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6718 call calc_eello(i,jp,i+1,jp1,jj,kk)
6719 if (wcorr4.gt.0.0d0)
6720 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6721 if (energy_dec.and.wcorr4.gt.0.0d0)
6722 1 write (iout,'(a6,4i5,0pf7.3)')
6723 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6724 c write (iout,*) "gradcorr5 before eello5"
6726 c write (iout,'(i5,3f10.5)')
6727 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6729 if (wcorr5.gt.0.0d0)
6730 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6731 c write (iout,*) "gradcorr5 after eello5"
6733 c write (iout,'(i5,3f10.5)')
6734 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6736 if (energy_dec.and.wcorr5.gt.0.0d0)
6737 1 write (iout,'(a6,4i5,0pf7.3)')
6738 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6739 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6740 cd write(2,*)'ijkl',i,jp,i+1,jp1
6741 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6742 & .or. wturn6.eq.0.0d0))then
6743 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6744 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6745 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6746 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6747 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6748 cd & 'ecorr6=',ecorr6
6749 cd write (iout,'(4e15.5)') sred_geom,
6750 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6751 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6752 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6753 else if (wturn6.gt.0.0d0
6754 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6755 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6756 eturn6=eturn6+eello_turn6(i,jj,kk)
6757 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6758 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6759 cd write (2,*) 'multibody_eello:eturn6',eturn6
6768 num_cont_hb(i)=num_cont_hb_old(i)
6770 c write (iout,*) "gradcorr5 in eello5"
6772 c write (iout,'(i5,3f10.5)')
6773 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6777 c------------------------------------------------------------------------------
6778 subroutine add_hb_contact_eello(ii,jj,itask)
6779 implicit real*8 (a-h,o-z)
6780 include "DIMENSIONS"
6781 include "COMMON.IOUNITS"
6784 parameter (max_cont=maxconts)
6785 parameter (max_dim=70)
6786 include "COMMON.CONTACTS"
6787 double precision zapas(max_dim,maxconts,max_fg_procs),
6788 & zapas_recv(max_dim,maxconts,max_fg_procs)
6789 common /przechowalnia/ zapas
6790 integer i,j,ii,jj,iproc,itask(4),nn
6791 c write (iout,*) "itask",itask
6794 if (iproc.gt.0) then
6795 do j=1,num_cont_hb(ii)
6797 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6799 ncont_sent(iproc)=ncont_sent(iproc)+1
6800 nn=ncont_sent(iproc)
6801 zapas(1,nn,iproc)=ii
6802 zapas(2,nn,iproc)=jjc
6803 zapas(3,nn,iproc)=d_cont(j,ii)
6807 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6812 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6820 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6832 c------------------------------------------------------------------------------
6833 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6834 implicit real*8 (a-h,o-z)
6835 include 'DIMENSIONS'
6836 include 'COMMON.IOUNITS'
6837 include 'COMMON.DERIV'
6838 include 'COMMON.INTERACT'
6839 include 'COMMON.CONTACTS'
6840 double precision gx(3),gx1(3)
6850 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6851 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6852 C Following 4 lines for diagnostics.
6857 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6858 c & 'Contacts ',i,j,
6859 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6860 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6862 C Calculate the multi-body contribution to energy.
6863 c ecorr=ecorr+ekont*ees
6864 C Calculate multi-body contributions to the gradient.
6865 coeffpees0pij=coeffp*ees0pij
6866 coeffmees0mij=coeffm*ees0mij
6867 coeffpees0pkl=coeffp*ees0pkl
6868 coeffmees0mkl=coeffm*ees0mkl
6870 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6871 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6872 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6873 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6874 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6875 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6876 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6877 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6878 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6879 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6880 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6881 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6882 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6883 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6884 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6885 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6886 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6887 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6888 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6889 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6890 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6891 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6892 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6893 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6894 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6899 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6900 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6901 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6902 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6907 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6908 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6909 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6910 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6913 c write (iout,*) "ehbcorr",ekont*ees
6918 C---------------------------------------------------------------------------
6919 subroutine dipole(i,j,jj)
6920 implicit real*8 (a-h,o-z)
6921 include 'DIMENSIONS'
6922 include 'COMMON.IOUNITS'
6923 include 'COMMON.CHAIN'
6924 include 'COMMON.FFIELD'
6925 include 'COMMON.DERIV'
6926 include 'COMMON.INTERACT'
6927 include 'COMMON.CONTACTS'
6928 include 'COMMON.TORSION'
6929 include 'COMMON.VAR'
6930 include 'COMMON.GEO'
6931 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6933 iti1 = itortyp(itype(i+1))
6934 if (j.lt.nres-1) then
6935 itj1 = itortyp(itype(j+1))
6940 dipi(iii,1)=Ub2(iii,i)
6941 dipderi(iii)=Ub2der(iii,i)
6942 dipi(iii,2)=b1(iii,iti1)
6943 dipj(iii,1)=Ub2(iii,j)
6944 dipderj(iii)=Ub2der(iii,j)
6945 dipj(iii,2)=b1(iii,itj1)
6949 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6952 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6959 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6963 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6968 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6969 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6971 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6973 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6975 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6980 C---------------------------------------------------------------------------
6981 subroutine calc_eello(i,j,k,l,jj,kk)
6983 C This subroutine computes matrices and vectors needed to calculate
6984 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6986 implicit real*8 (a-h,o-z)
6987 include 'DIMENSIONS'
6988 include 'COMMON.IOUNITS'
6989 include 'COMMON.CHAIN'
6990 include 'COMMON.DERIV'
6991 include 'COMMON.INTERACT'
6992 include 'COMMON.CONTACTS'
6993 include 'COMMON.TORSION'
6994 include 'COMMON.VAR'
6995 include 'COMMON.GEO'
6996 include 'COMMON.FFIELD'
6997 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6998 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7001 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7002 cd & ' jj=',jj,' kk=',kk
7003 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7004 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7005 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7008 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7009 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7012 call transpose2(aa1(1,1),aa1t(1,1))
7013 call transpose2(aa2(1,1),aa2t(1,1))
7016 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7017 & aa1tder(1,1,lll,kkk))
7018 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7019 & aa2tder(1,1,lll,kkk))
7023 C parallel orientation of the two CA-CA-CA frames.
7025 iti=itortyp(itype(i))
7029 itk1=itortyp(itype(k+1))
7030 itj=itortyp(itype(j))
7031 if (l.lt.nres-1) then
7032 itl1=itortyp(itype(l+1))
7036 C A1 kernel(j+1) A2T
7038 cd write (iout,'(3f10.5,5x,3f10.5)')
7039 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7041 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7042 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7043 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7044 C Following matrices are needed only for 6-th order cumulants
7045 IF (wcorr6.gt.0.0d0) THEN
7046 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7047 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7048 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7049 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7050 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7051 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7052 & ADtEAderx(1,1,1,1,1,1))
7054 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7055 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7056 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7057 & ADtEA1derx(1,1,1,1,1,1))
7059 C End 6-th order cumulants
7062 cd write (2,*) 'In calc_eello6'
7064 cd write (2,*) 'iii=',iii
7066 cd write (2,*) 'kkk=',kkk
7068 cd write (2,'(3(2f10.5),5x)')
7069 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7074 call transpose2(EUgder(1,1,k),auxmat(1,1))
7075 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7076 call transpose2(EUg(1,1,k),auxmat(1,1))
7077 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7078 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7082 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7083 & EAEAderx(1,1,lll,kkk,iii,1))
7087 C A1T kernel(i+1) A2
7088 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7089 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7090 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7091 C Following matrices are needed only for 6-th order cumulants
7092 IF (wcorr6.gt.0.0d0) THEN
7093 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7094 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7095 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7096 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7097 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7098 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7099 & ADtEAderx(1,1,1,1,1,2))
7100 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7101 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7102 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7103 & ADtEA1derx(1,1,1,1,1,2))
7105 C End 6-th order cumulants
7106 call transpose2(EUgder(1,1,l),auxmat(1,1))
7107 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7108 call transpose2(EUg(1,1,l),auxmat(1,1))
7109 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7110 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7114 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7115 & EAEAderx(1,1,lll,kkk,iii,2))
7120 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7121 C They are needed only when the fifth- or the sixth-order cumulants are
7123 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7124 call transpose2(AEA(1,1,1),auxmat(1,1))
7125 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7126 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7127 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7128 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7129 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7130 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7131 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7132 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7133 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7134 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7135 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7136 call transpose2(AEA(1,1,2),auxmat(1,1))
7137 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7138 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7139 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7140 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7141 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7142 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7143 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7144 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7145 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7146 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7147 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7148 C Calculate the Cartesian derivatives of the vectors.
7152 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7153 call matvec2(auxmat(1,1),b1(1,iti),
7154 & AEAb1derx(1,lll,kkk,iii,1,1))
7155 call matvec2(auxmat(1,1),Ub2(1,i),
7156 & AEAb2derx(1,lll,kkk,iii,1,1))
7157 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7158 & AEAb1derx(1,lll,kkk,iii,2,1))
7159 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7160 & AEAb2derx(1,lll,kkk,iii,2,1))
7161 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7162 call matvec2(auxmat(1,1),b1(1,itj),
7163 & AEAb1derx(1,lll,kkk,iii,1,2))
7164 call matvec2(auxmat(1,1),Ub2(1,j),
7165 & AEAb2derx(1,lll,kkk,iii,1,2))
7166 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7167 & AEAb1derx(1,lll,kkk,iii,2,2))
7168 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7169 & AEAb2derx(1,lll,kkk,iii,2,2))
7176 C Antiparallel orientation of the two CA-CA-CA frames.
7178 iti=itortyp(itype(i))
7182 itk1=itortyp(itype(k+1))
7183 itl=itortyp(itype(l))
7184 itj=itortyp(itype(j))
7185 if (j.lt.nres-1) then
7186 itj1=itortyp(itype(j+1))
7190 C A2 kernel(j-1)T A1T
7191 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7192 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7193 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7194 C Following matrices are needed only for 6-th order cumulants
7195 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7196 & j.eq.i+4 .and. l.eq.i+3)) THEN
7197 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7198 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7199 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7200 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7201 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7202 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7203 & ADtEAderx(1,1,1,1,1,1))
7204 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7205 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7206 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7207 & ADtEA1derx(1,1,1,1,1,1))
7209 C End 6-th order cumulants
7210 call transpose2(EUgder(1,1,k),auxmat(1,1))
7211 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7212 call transpose2(EUg(1,1,k),auxmat(1,1))
7213 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7214 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7218 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7219 & EAEAderx(1,1,lll,kkk,iii,1))
7223 C A2T kernel(i+1)T A1
7224 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7225 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7226 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7227 C Following matrices are needed only for 6-th order cumulants
7228 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7229 & j.eq.i+4 .and. l.eq.i+3)) THEN
7230 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7231 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7232 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7233 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7234 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7235 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7236 & ADtEAderx(1,1,1,1,1,2))
7237 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7238 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7239 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7240 & ADtEA1derx(1,1,1,1,1,2))
7242 C End 6-th order cumulants
7243 call transpose2(EUgder(1,1,j),auxmat(1,1))
7244 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7245 call transpose2(EUg(1,1,j),auxmat(1,1))
7246 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7247 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7251 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7252 & EAEAderx(1,1,lll,kkk,iii,2))
7257 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7258 C They are needed only when the fifth- or the sixth-order cumulants are
7260 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7261 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7262 call transpose2(AEA(1,1,1),auxmat(1,1))
7263 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7264 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7265 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7266 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7267 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7268 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7269 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7270 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7271 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7272 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7273 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7274 call transpose2(AEA(1,1,2),auxmat(1,1))
7275 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7276 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7277 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7278 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7279 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7280 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7281 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7282 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7283 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7284 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7285 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7286 C Calculate the Cartesian derivatives of the vectors.
7290 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7291 call matvec2(auxmat(1,1),b1(1,iti),
7292 & AEAb1derx(1,lll,kkk,iii,1,1))
7293 call matvec2(auxmat(1,1),Ub2(1,i),
7294 & AEAb2derx(1,lll,kkk,iii,1,1))
7295 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7296 & AEAb1derx(1,lll,kkk,iii,2,1))
7297 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7298 & AEAb2derx(1,lll,kkk,iii,2,1))
7299 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7300 call matvec2(auxmat(1,1),b1(1,itl),
7301 & AEAb1derx(1,lll,kkk,iii,1,2))
7302 call matvec2(auxmat(1,1),Ub2(1,l),
7303 & AEAb2derx(1,lll,kkk,iii,1,2))
7304 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7305 & AEAb1derx(1,lll,kkk,iii,2,2))
7306 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7307 & AEAb2derx(1,lll,kkk,iii,2,2))
7316 C---------------------------------------------------------------------------
7317 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7318 & KK,KKderg,AKA,AKAderg,AKAderx)
7322 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7323 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7324 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7329 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7331 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7334 cd if (lprn) write (2,*) 'In kernel'
7336 cd if (lprn) write (2,*) 'kkk=',kkk
7338 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7339 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7341 cd write (2,*) 'lll=',lll
7342 cd write (2,*) 'iii=1'
7344 cd write (2,'(3(2f10.5),5x)')
7345 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7348 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7349 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7351 cd write (2,*) 'lll=',lll
7352 cd write (2,*) 'iii=2'
7354 cd write (2,'(3(2f10.5),5x)')
7355 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7362 C---------------------------------------------------------------------------
7363 double precision function eello4(i,j,k,l,jj,kk)
7364 implicit real*8 (a-h,o-z)
7365 include 'DIMENSIONS'
7366 include 'COMMON.IOUNITS'
7367 include 'COMMON.CHAIN'
7368 include 'COMMON.DERIV'
7369 include 'COMMON.INTERACT'
7370 include 'COMMON.CONTACTS'
7371 include 'COMMON.TORSION'
7372 include 'COMMON.VAR'
7373 include 'COMMON.GEO'
7374 double precision pizda(2,2),ggg1(3),ggg2(3)
7375 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7379 cd print *,'eello4:',i,j,k,l,jj,kk
7380 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7381 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7382 cold eij=facont_hb(jj,i)
7383 cold ekl=facont_hb(kk,k)
7385 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7386 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7387 gcorr_loc(k-1)=gcorr_loc(k-1)
7388 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7390 gcorr_loc(l-1)=gcorr_loc(l-1)
7391 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7393 gcorr_loc(j-1)=gcorr_loc(j-1)
7394 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7399 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7400 & -EAEAderx(2,2,lll,kkk,iii,1)
7401 cd derx(lll,kkk,iii)=0.0d0
7405 cd gcorr_loc(l-1)=0.0d0
7406 cd gcorr_loc(j-1)=0.0d0
7407 cd gcorr_loc(k-1)=0.0d0
7409 cd write (iout,*)'Contacts have occurred for peptide groups',
7410 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7411 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7412 if (j.lt.nres-1) then
7419 if (l.lt.nres-1) then
7427 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7428 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7429 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7430 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7431 cgrad ghalf=0.5d0*ggg1(ll)
7432 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7433 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7434 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7435 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7436 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7437 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7438 cgrad ghalf=0.5d0*ggg2(ll)
7439 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7440 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7441 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7442 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7443 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7444 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7448 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7453 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7458 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7463 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7467 cd write (2,*) iii,gcorr_loc(iii)
7470 cd write (2,*) 'ekont',ekont
7471 cd write (iout,*) 'eello4',ekont*eel4
7474 C---------------------------------------------------------------------------
7475 double precision function eello5(i,j,k,l,jj,kk)
7476 implicit real*8 (a-h,o-z)
7477 include 'DIMENSIONS'
7478 include 'COMMON.IOUNITS'
7479 include 'COMMON.CHAIN'
7480 include 'COMMON.DERIV'
7481 include 'COMMON.INTERACT'
7482 include 'COMMON.CONTACTS'
7483 include 'COMMON.TORSION'
7484 include 'COMMON.VAR'
7485 include 'COMMON.GEO'
7486 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7487 double precision ggg1(3),ggg2(3)
7488 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7493 C /l\ / \ \ / \ / \ / C
7494 C / \ / \ \ / \ / \ / C
7495 C j| o |l1 | o | o| o | | o |o C
7496 C \ |/k\| |/ \| / |/ \| |/ \| C
7497 C \i/ \ / \ / / \ / \ C
7499 C (I) (II) (III) (IV) C
7501 C eello5_1 eello5_2 eello5_3 eello5_4 C
7503 C Antiparallel chains C
7506 C /j\ / \ \ / \ / \ / C
7507 C / \ / \ \ / \ / \ / C
7508 C j1| o |l | o | o| o | | o |o C
7509 C \ |/k\| |/ \| / |/ \| |/ \| C
7510 C \i/ \ / \ / / \ / \ C
7512 C (I) (II) (III) (IV) C
7514 C eello5_1 eello5_2 eello5_3 eello5_4 C
7516 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7518 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7519 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7524 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7526 itk=itortyp(itype(k))
7527 itl=itortyp(itype(l))
7528 itj=itortyp(itype(j))
7533 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7534 cd & eel5_3_num,eel5_4_num)
7538 derx(lll,kkk,iii)=0.0d0
7542 cd eij=facont_hb(jj,i)
7543 cd ekl=facont_hb(kk,k)
7545 cd write (iout,*)'Contacts have occurred for peptide groups',
7546 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7548 C Contribution from the graph I.
7549 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7550 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7551 call transpose2(EUg(1,1,k),auxmat(1,1))
7552 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7553 vv(1)=pizda(1,1)-pizda(2,2)
7554 vv(2)=pizda(1,2)+pizda(2,1)
7555 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7556 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7557 C Explicit gradient in virtual-dihedral angles.
7558 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7559 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7560 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7561 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7562 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7563 vv(1)=pizda(1,1)-pizda(2,2)
7564 vv(2)=pizda(1,2)+pizda(2,1)
7565 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7566 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7567 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7568 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7569 vv(1)=pizda(1,1)-pizda(2,2)
7570 vv(2)=pizda(1,2)+pizda(2,1)
7572 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7573 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7574 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7576 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7577 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7578 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7580 C Cartesian gradient
7584 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7586 vv(1)=pizda(1,1)-pizda(2,2)
7587 vv(2)=pizda(1,2)+pizda(2,1)
7588 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7589 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7590 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7596 C Contribution from graph II
7597 call transpose2(EE(1,1,itk),auxmat(1,1))
7598 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7599 vv(1)=pizda(1,1)+pizda(2,2)
7600 vv(2)=pizda(2,1)-pizda(1,2)
7601 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7602 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7603 C Explicit gradient in virtual-dihedral angles.
7604 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7605 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7606 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7607 vv(1)=pizda(1,1)+pizda(2,2)
7608 vv(2)=pizda(2,1)-pizda(1,2)
7610 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7611 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7612 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7614 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7615 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7616 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7618 C Cartesian gradient
7622 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7624 vv(1)=pizda(1,1)+pizda(2,2)
7625 vv(2)=pizda(2,1)-pizda(1,2)
7626 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7627 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7628 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7636 C Parallel orientation
7637 C Contribution from graph III
7638 call transpose2(EUg(1,1,l),auxmat(1,1))
7639 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7640 vv(1)=pizda(1,1)-pizda(2,2)
7641 vv(2)=pizda(1,2)+pizda(2,1)
7642 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7643 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7644 C Explicit gradient in virtual-dihedral angles.
7645 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7646 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7647 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7648 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7649 vv(1)=pizda(1,1)-pizda(2,2)
7650 vv(2)=pizda(1,2)+pizda(2,1)
7651 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7652 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7653 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7654 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7655 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7656 vv(1)=pizda(1,1)-pizda(2,2)
7657 vv(2)=pizda(1,2)+pizda(2,1)
7658 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7659 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7660 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7661 C Cartesian gradient
7665 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7667 vv(1)=pizda(1,1)-pizda(2,2)
7668 vv(2)=pizda(1,2)+pizda(2,1)
7669 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7670 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7671 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7676 C Contribution from graph IV
7678 call transpose2(EE(1,1,itl),auxmat(1,1))
7679 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7680 vv(1)=pizda(1,1)+pizda(2,2)
7681 vv(2)=pizda(2,1)-pizda(1,2)
7682 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7683 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7684 C Explicit gradient in virtual-dihedral angles.
7685 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7686 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7687 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7688 vv(1)=pizda(1,1)+pizda(2,2)
7689 vv(2)=pizda(2,1)-pizda(1,2)
7690 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7691 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7692 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7693 C Cartesian gradient
7697 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7699 vv(1)=pizda(1,1)+pizda(2,2)
7700 vv(2)=pizda(2,1)-pizda(1,2)
7701 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7702 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7703 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7708 C Antiparallel orientation
7709 C Contribution from graph III
7711 call transpose2(EUg(1,1,j),auxmat(1,1))
7712 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7713 vv(1)=pizda(1,1)-pizda(2,2)
7714 vv(2)=pizda(1,2)+pizda(2,1)
7715 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7716 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7717 C Explicit gradient in virtual-dihedral angles.
7718 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7719 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7720 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7721 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7722 vv(1)=pizda(1,1)-pizda(2,2)
7723 vv(2)=pizda(1,2)+pizda(2,1)
7724 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7725 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7726 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7727 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7728 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7729 vv(1)=pizda(1,1)-pizda(2,2)
7730 vv(2)=pizda(1,2)+pizda(2,1)
7731 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7732 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7733 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7734 C Cartesian gradient
7738 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7740 vv(1)=pizda(1,1)-pizda(2,2)
7741 vv(2)=pizda(1,2)+pizda(2,1)
7742 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7743 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7744 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7749 C Contribution from graph IV
7751 call transpose2(EE(1,1,itj),auxmat(1,1))
7752 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7753 vv(1)=pizda(1,1)+pizda(2,2)
7754 vv(2)=pizda(2,1)-pizda(1,2)
7755 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7756 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7757 C Explicit gradient in virtual-dihedral angles.
7758 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7759 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7760 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7761 vv(1)=pizda(1,1)+pizda(2,2)
7762 vv(2)=pizda(2,1)-pizda(1,2)
7763 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7764 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7765 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7766 C Cartesian gradient
7770 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7772 vv(1)=pizda(1,1)+pizda(2,2)
7773 vv(2)=pizda(2,1)-pizda(1,2)
7774 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7775 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7776 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7782 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7783 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7784 cd write (2,*) 'ijkl',i,j,k,l
7785 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7786 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7788 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7789 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7790 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7791 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7792 if (j.lt.nres-1) then
7799 if (l.lt.nres-1) then
7809 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7810 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7811 C summed up outside the subrouine as for the other subroutines
7812 C handling long-range interactions. The old code is commented out
7813 C with "cgrad" to keep track of changes.
7815 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7816 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7817 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7818 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7819 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7820 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7821 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7822 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7823 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7824 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7826 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7827 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7828 cgrad ghalf=0.5d0*ggg1(ll)
7830 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7831 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7832 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7833 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7834 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7835 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7836 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7837 cgrad ghalf=0.5d0*ggg2(ll)
7839 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
7840 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7841 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
7842 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7843 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7844 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7849 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7850 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7855 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7856 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7862 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7867 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7871 cd write (2,*) iii,g_corr5_loc(iii)
7874 cd write (2,*) 'ekont',ekont
7875 cd write (iout,*) 'eello5',ekont*eel5
7878 c--------------------------------------------------------------------------
7879 double precision function eello6(i,j,k,l,jj,kk)
7880 implicit real*8 (a-h,o-z)
7881 include 'DIMENSIONS'
7882 include 'COMMON.IOUNITS'
7883 include 'COMMON.CHAIN'
7884 include 'COMMON.DERIV'
7885 include 'COMMON.INTERACT'
7886 include 'COMMON.CONTACTS'
7887 include 'COMMON.TORSION'
7888 include 'COMMON.VAR'
7889 include 'COMMON.GEO'
7890 include 'COMMON.FFIELD'
7891 double precision ggg1(3),ggg2(3)
7892 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7897 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7905 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7906 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7910 derx(lll,kkk,iii)=0.0d0
7914 cd eij=facont_hb(jj,i)
7915 cd ekl=facont_hb(kk,k)
7921 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7922 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7923 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7924 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7925 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7926 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7928 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7929 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7930 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7931 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7932 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7933 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7937 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7939 C If turn contributions are considered, they will be handled separately.
7940 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7941 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7942 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7943 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7944 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7945 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7946 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7948 if (j.lt.nres-1) then
7955 if (l.lt.nres-1) then
7963 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7964 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7965 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7966 cgrad ghalf=0.5d0*ggg1(ll)
7968 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7969 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7970 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7971 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7972 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7973 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7974 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7975 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7976 cgrad ghalf=0.5d0*ggg2(ll)
7977 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7979 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7980 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7981 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7982 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7983 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7984 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7989 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7990 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7995 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7996 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8002 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8007 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8011 cd write (2,*) iii,g_corr6_loc(iii)
8014 cd write (2,*) 'ekont',ekont
8015 cd write (iout,*) 'eello6',ekont*eel6
8018 c--------------------------------------------------------------------------
8019 double precision function eello6_graph1(i,j,k,l,imat,swap)
8020 implicit real*8 (a-h,o-z)
8021 include 'DIMENSIONS'
8022 include 'COMMON.IOUNITS'
8023 include 'COMMON.CHAIN'
8024 include 'COMMON.DERIV'
8025 include 'COMMON.INTERACT'
8026 include 'COMMON.CONTACTS'
8027 include 'COMMON.TORSION'
8028 include 'COMMON.VAR'
8029 include 'COMMON.GEO'
8030 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8034 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8036 C Parallel Antiparallel C
8042 C \ j|/k\| / \ |/k\|l / C
8047 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8048 itk=itortyp(itype(k))
8049 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8050 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8051 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8052 call transpose2(EUgC(1,1,k),auxmat(1,1))
8053 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8054 vv1(1)=pizda1(1,1)-pizda1(2,2)
8055 vv1(2)=pizda1(1,2)+pizda1(2,1)
8056 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8057 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8058 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8059 s5=scalar2(vv(1),Dtobr2(1,i))
8060 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8061 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8062 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8063 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8064 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8065 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8066 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8067 & +scalar2(vv(1),Dtobr2der(1,i)))
8068 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8069 vv1(1)=pizda1(1,1)-pizda1(2,2)
8070 vv1(2)=pizda1(1,2)+pizda1(2,1)
8071 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8072 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8074 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8075 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8076 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8077 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8078 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8080 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8081 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8082 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8083 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8084 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8086 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8087 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8088 vv1(1)=pizda1(1,1)-pizda1(2,2)
8089 vv1(2)=pizda1(1,2)+pizda1(2,1)
8090 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8091 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8092 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8093 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8102 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8103 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8104 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8105 call transpose2(EUgC(1,1,k),auxmat(1,1))
8106 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8108 vv1(1)=pizda1(1,1)-pizda1(2,2)
8109 vv1(2)=pizda1(1,2)+pizda1(2,1)
8110 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8111 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8112 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8113 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8114 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8115 s5=scalar2(vv(1),Dtobr2(1,i))
8116 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8122 c----------------------------------------------------------------------------
8123 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8124 implicit real*8 (a-h,o-z)
8125 include 'DIMENSIONS'
8126 include 'COMMON.IOUNITS'
8127 include 'COMMON.CHAIN'
8128 include 'COMMON.DERIV'
8129 include 'COMMON.INTERACT'
8130 include 'COMMON.CONTACTS'
8131 include 'COMMON.TORSION'
8132 include 'COMMON.VAR'
8133 include 'COMMON.GEO'
8135 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8136 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8139 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8141 C Parallel Antiparallel C
8147 C \ j|/k\| \ |/k\|l C
8152 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8153 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8154 C AL 7/4/01 s1 would occur in the sixth-order moment,
8155 C but not in a cluster cumulant
8157 s1=dip(1,jj,i)*dip(1,kk,k)
8159 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8160 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8161 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8162 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8163 call transpose2(EUg(1,1,k),auxmat(1,1))
8164 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8165 vv(1)=pizda(1,1)-pizda(2,2)
8166 vv(2)=pizda(1,2)+pizda(2,1)
8167 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8168 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8170 eello6_graph2=-(s1+s2+s3+s4)
8172 eello6_graph2=-(s2+s3+s4)
8175 C Derivatives in gamma(i-1)
8178 s1=dipderg(1,jj,i)*dip(1,kk,k)
8180 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8181 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8182 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8183 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8185 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8187 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8189 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8191 C Derivatives in gamma(k-1)
8193 s1=dip(1,jj,i)*dipderg(1,kk,k)
8195 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8196 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8197 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8198 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8199 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8200 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8201 vv(1)=pizda(1,1)-pizda(2,2)
8202 vv(2)=pizda(1,2)+pizda(2,1)
8203 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8205 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8207 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8209 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8210 C Derivatives in gamma(j-1) or gamma(l-1)
8213 s1=dipderg(3,jj,i)*dip(1,kk,k)
8215 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8216 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8217 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8218 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8219 vv(1)=pizda(1,1)-pizda(2,2)
8220 vv(2)=pizda(1,2)+pizda(2,1)
8221 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8224 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8226 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8229 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8230 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8232 C Derivatives in gamma(l-1) or gamma(j-1)
8235 s1=dip(1,jj,i)*dipderg(3,kk,k)
8237 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8238 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8239 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8240 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8241 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8242 vv(1)=pizda(1,1)-pizda(2,2)
8243 vv(2)=pizda(1,2)+pizda(2,1)
8244 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8247 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8249 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8252 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8253 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8255 C Cartesian derivatives.
8257 write (2,*) 'In eello6_graph2'
8259 write (2,*) 'iii=',iii
8261 write (2,*) 'kkk=',kkk
8263 write (2,'(3(2f10.5),5x)')
8264 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8274 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8276 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8279 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8281 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8282 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8284 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8285 call transpose2(EUg(1,1,k),auxmat(1,1))
8286 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8288 vv(1)=pizda(1,1)-pizda(2,2)
8289 vv(2)=pizda(1,2)+pizda(2,1)
8290 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8291 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8293 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8295 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8298 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8300 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8307 c----------------------------------------------------------------------------
8308 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8309 implicit real*8 (a-h,o-z)
8310 include 'DIMENSIONS'
8311 include 'COMMON.IOUNITS'
8312 include 'COMMON.CHAIN'
8313 include 'COMMON.DERIV'
8314 include 'COMMON.INTERACT'
8315 include 'COMMON.CONTACTS'
8316 include 'COMMON.TORSION'
8317 include 'COMMON.VAR'
8318 include 'COMMON.GEO'
8319 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8321 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8323 C Parallel Antiparallel C
8329 C j|/k\| / |/k\|l / C
8334 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8336 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8337 C energy moment and not to the cluster cumulant.
8338 iti=itortyp(itype(i))
8339 if (j.lt.nres-1) then
8340 itj1=itortyp(itype(j+1))
8344 itk=itortyp(itype(k))
8345 itk1=itortyp(itype(k+1))
8346 if (l.lt.nres-1) then
8347 itl1=itortyp(itype(l+1))
8352 s1=dip(4,jj,i)*dip(4,kk,k)
8354 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8355 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8356 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8357 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8358 call transpose2(EE(1,1,itk),auxmat(1,1))
8359 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8360 vv(1)=pizda(1,1)+pizda(2,2)
8361 vv(2)=pizda(2,1)-pizda(1,2)
8362 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8363 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8364 cd & "sum",-(s2+s3+s4)
8366 eello6_graph3=-(s1+s2+s3+s4)
8368 eello6_graph3=-(s2+s3+s4)
8371 C Derivatives in gamma(k-1)
8372 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8373 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8374 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8375 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8376 C Derivatives in gamma(l-1)
8377 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8378 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8379 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8380 vv(1)=pizda(1,1)+pizda(2,2)
8381 vv(2)=pizda(2,1)-pizda(1,2)
8382 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8383 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8384 C Cartesian derivatives.
8390 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8392 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8395 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8397 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8398 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8400 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8401 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8403 vv(1)=pizda(1,1)+pizda(2,2)
8404 vv(2)=pizda(2,1)-pizda(1,2)
8405 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8407 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8409 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8412 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8414 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8416 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8422 c----------------------------------------------------------------------------
8423 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8424 implicit real*8 (a-h,o-z)
8425 include 'DIMENSIONS'
8426 include 'COMMON.IOUNITS'
8427 include 'COMMON.CHAIN'
8428 include 'COMMON.DERIV'
8429 include 'COMMON.INTERACT'
8430 include 'COMMON.CONTACTS'
8431 include 'COMMON.TORSION'
8432 include 'COMMON.VAR'
8433 include 'COMMON.GEO'
8434 include 'COMMON.FFIELD'
8435 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8436 & auxvec1(2),auxmat1(2,2)
8438 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8440 C Parallel Antiparallel C
8446 C \ j|/k\| \ |/k\|l C
8451 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8453 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8454 C energy moment and not to the cluster cumulant.
8455 cd write (2,*) 'eello_graph4: wturn6',wturn6
8456 iti=itortyp(itype(i))
8457 itj=itortyp(itype(j))
8458 if (j.lt.nres-1) then
8459 itj1=itortyp(itype(j+1))
8463 itk=itortyp(itype(k))
8464 if (k.lt.nres-1) then
8465 itk1=itortyp(itype(k+1))
8469 itl=itortyp(itype(l))
8470 if (l.lt.nres-1) then
8471 itl1=itortyp(itype(l+1))
8475 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8476 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8477 cd & ' itl',itl,' itl1',itl1
8480 s1=dip(3,jj,i)*dip(3,kk,k)
8482 s1=dip(2,jj,j)*dip(2,kk,l)
8485 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8486 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8488 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8489 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8491 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8492 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8494 call transpose2(EUg(1,1,k),auxmat(1,1))
8495 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8496 vv(1)=pizda(1,1)-pizda(2,2)
8497 vv(2)=pizda(2,1)+pizda(1,2)
8498 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8499 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8501 eello6_graph4=-(s1+s2+s3+s4)
8503 eello6_graph4=-(s2+s3+s4)
8505 C Derivatives in gamma(i-1)
8509 s1=dipderg(2,jj,i)*dip(3,kk,k)
8511 s1=dipderg(4,jj,j)*dip(2,kk,l)
8514 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8516 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8517 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8519 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8520 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8522 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8523 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8524 cd write (2,*) 'turn6 derivatives'
8526 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8528 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8532 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8534 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8538 C Derivatives in gamma(k-1)
8541 s1=dip(3,jj,i)*dipderg(2,kk,k)
8543 s1=dip(2,jj,j)*dipderg(4,kk,l)
8546 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8547 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8549 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8550 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8552 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8553 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8555 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8556 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8557 vv(1)=pizda(1,1)-pizda(2,2)
8558 vv(2)=pizda(2,1)+pizda(1,2)
8559 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8560 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8562 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8564 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8568 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8570 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8573 C Derivatives in gamma(j-1) or gamma(l-1)
8574 if (l.eq.j+1 .and. l.gt.1) then
8575 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8576 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8577 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8578 vv(1)=pizda(1,1)-pizda(2,2)
8579 vv(2)=pizda(2,1)+pizda(1,2)
8580 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8581 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8582 else if (j.gt.1) then
8583 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8584 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8585 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8586 vv(1)=pizda(1,1)-pizda(2,2)
8587 vv(2)=pizda(2,1)+pizda(1,2)
8588 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8589 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8590 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8592 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8595 C Cartesian derivatives.
8602 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8604 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8608 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8610 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8614 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8616 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8618 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8619 & b1(1,itj1),auxvec(1))
8620 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8622 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8623 & b1(1,itl1),auxvec(1))
8624 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8626 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8628 vv(1)=pizda(1,1)-pizda(2,2)
8629 vv(2)=pizda(2,1)+pizda(1,2)
8630 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8632 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8634 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8637 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8640 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8643 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8645 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8647 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8651 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8653 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8656 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8658 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8666 c----------------------------------------------------------------------------
8667 double precision function eello_turn6(i,jj,kk)
8668 implicit real*8 (a-h,o-z)
8669 include 'DIMENSIONS'
8670 include 'COMMON.IOUNITS'
8671 include 'COMMON.CHAIN'
8672 include 'COMMON.DERIV'
8673 include 'COMMON.INTERACT'
8674 include 'COMMON.CONTACTS'
8675 include 'COMMON.TORSION'
8676 include 'COMMON.VAR'
8677 include 'COMMON.GEO'
8678 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8679 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8681 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8682 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8683 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8684 C the respective energy moment and not to the cluster cumulant.
8693 iti=itortyp(itype(i))
8694 itk=itortyp(itype(k))
8695 itk1=itortyp(itype(k+1))
8696 itl=itortyp(itype(l))
8697 itj=itortyp(itype(j))
8698 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8699 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8700 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8705 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8707 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8711 derx_turn(lll,kkk,iii)=0.0d0
8718 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8720 cd write (2,*) 'eello6_5',eello6_5
8722 call transpose2(AEA(1,1,1),auxmat(1,1))
8723 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8724 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8725 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8727 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8728 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8729 s2 = scalar2(b1(1,itk),vtemp1(1))
8731 call transpose2(AEA(1,1,2),atemp(1,1))
8732 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8733 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8734 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8736 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8737 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8738 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8740 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8741 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8742 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8743 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8744 ss13 = scalar2(b1(1,itk),vtemp4(1))
8745 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8747 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8753 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8754 C Derivatives in gamma(i+2)
8758 call transpose2(AEA(1,1,1),auxmatd(1,1))
8759 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8760 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8761 call transpose2(AEAderg(1,1,2),atempd(1,1))
8762 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8763 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8765 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8766 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8767 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8773 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8774 C Derivatives in gamma(i+3)
8776 call transpose2(AEA(1,1,1),auxmatd(1,1))
8777 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8778 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8779 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8781 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8782 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8783 s2d = scalar2(b1(1,itk),vtemp1d(1))
8785 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8786 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8788 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8790 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8791 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8792 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8800 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8801 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8803 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8804 & -0.5d0*ekont*(s2d+s12d)
8806 C Derivatives in gamma(i+4)
8807 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8808 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8809 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8811 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8812 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8813 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8821 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8823 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8825 C Derivatives in gamma(i+5)
8827 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8828 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8829 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8831 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8832 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8833 s2d = scalar2(b1(1,itk),vtemp1d(1))
8835 call transpose2(AEA(1,1,2),atempd(1,1))
8836 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8837 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8839 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8840 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8842 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8843 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8844 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8852 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8853 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8855 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8856 & -0.5d0*ekont*(s2d+s12d)
8858 C Cartesian derivatives
8863 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8864 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8865 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8867 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8868 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8870 s2d = scalar2(b1(1,itk),vtemp1d(1))
8872 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8873 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8874 s8d = -(atempd(1,1)+atempd(2,2))*
8875 & scalar2(cc(1,1,itl),vtemp2(1))
8877 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8879 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8880 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8887 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8890 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8894 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8895 & - 0.5d0*(s8d+s12d)
8897 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8906 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8908 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8909 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8910 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8911 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8912 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8914 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8915 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8916 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8920 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8921 cd & 16*eel_turn6_num
8923 if (j.lt.nres-1) then
8930 if (l.lt.nres-1) then
8938 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8939 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8940 cgrad ghalf=0.5d0*ggg1(ll)
8942 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8943 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8944 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8945 & +ekont*derx_turn(ll,2,1)
8946 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8947 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8948 & +ekont*derx_turn(ll,4,1)
8949 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8950 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8951 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8952 cgrad ghalf=0.5d0*ggg2(ll)
8954 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8955 & +ekont*derx_turn(ll,2,2)
8956 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8957 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8958 & +ekont*derx_turn(ll,4,2)
8959 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8960 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8961 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8966 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8971 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8977 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8982 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8986 cd write (2,*) iii,g_corr6_loc(iii)
8988 eello_turn6=ekont*eel_turn6
8989 cd write (2,*) 'ekont',ekont
8990 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8994 C-----------------------------------------------------------------------------
8995 double precision function scalar(u,v)
8996 !DIR$ INLINEALWAYS scalar
8998 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9001 double precision u(3),v(3)
9002 cd double precision sc
9010 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9013 crc-------------------------------------------------
9014 SUBROUTINE MATVEC2(A1,V1,V2)
9015 !DIR$ INLINEALWAYS MATVEC2
9017 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9019 implicit real*8 (a-h,o-z)
9020 include 'DIMENSIONS'
9021 DIMENSION A1(2,2),V1(2),V2(2)
9025 c 3 VI=VI+A1(I,K)*V1(K)
9029 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9030 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9035 C---------------------------------------
9036 SUBROUTINE MATMAT2(A1,A2,A3)
9038 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9040 implicit real*8 (a-h,o-z)
9041 include 'DIMENSIONS'
9042 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9043 c DIMENSION AI3(2,2)
9047 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9053 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9054 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9055 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9056 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9064 c-------------------------------------------------------------------------
9065 double precision function scalar2(u,v)
9066 !DIR$ INLINEALWAYS scalar2
9068 double precision u(2),v(2)
9071 scalar2=u(1)*v(1)+u(2)*v(2)
9075 C-----------------------------------------------------------------------------
9077 subroutine transpose2(a,at)
9078 !DIR$ INLINEALWAYS transpose2
9080 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9083 double precision a(2,2),at(2,2)
9090 c--------------------------------------------------------------------------
9091 subroutine transpose(n,a,at)
9094 double precision a(n,n),at(n,n)
9102 C---------------------------------------------------------------------------
9103 subroutine prodmat3(a1,a2,kk,transp,prod)
9104 !DIR$ INLINEALWAYS prodmat3
9106 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9110 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9112 crc double precision auxmat(2,2),prod_(2,2)
9115 crc call transpose2(kk(1,1),auxmat(1,1))
9116 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9117 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9119 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9120 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9121 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9122 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9123 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9124 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9125 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9126 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9129 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9130 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9132 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9133 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9134 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9135 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9136 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9137 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9138 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9139 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9142 c call transpose2(a2(1,1),a2t(1,1))
9145 crc print *,((prod_(i,j),i=1,2),j=1,2)
9146 crc print *,((prod(i,j),i=1,2),j=1,2)