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 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4094 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4095 if (link_end.eq.0) return
4096 do i=link_start,link_end
4097 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4098 C CA-CA distance used in regularization of structure.
4101 C iii and jjj point to the residues for which the distance is assigned.
4102 if (ii.gt.nres) then
4109 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4110 c & dhpb(i),dhpb1(i),forcon(i)
4111 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4112 C distance and angle dependent SS bond potential.
4113 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4114 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4115 if (.not.dyn_ss .and. i.le.nss) then
4116 C 15/02/13 CC dynamic SSbond - additional check
4117 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4118 & iabs(itype(jjj)).eq.1) then
4119 call ssbond_ene(iii,jjj,eij)
4122 cd write (iout,*) "eij",eij
4123 cd & ' waga=',waga,' fac=',fac
4124 else if (ii.gt.nres .and. jj.gt.nres) then
4125 c Restraints from contact prediction
4127 if (constr_dist.eq.11) then
4128 ehpb=ehpb+fordepth(i)**4.0d0
4129 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4130 fac=fordepth(i)**4.0d0
4131 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4133 if (dhpb1(i).gt.0.0d0) then
4134 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4135 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4136 c write (iout,*) "beta nmr",
4137 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4141 C Get the force constant corresponding to this distance.
4143 C Calculate the contribution to energy.
4144 ehpb=ehpb+waga*rdis*rdis
4145 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4147 C Evaluate gradient.
4153 ggg(j)=fac*(c(j,jj)-c(j,ii))
4156 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4157 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4160 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4161 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4164 C Calculate the distance between the two points and its difference from the
4167 if (constr_dist.eq.11) then
4168 ehpb=ehpb+fordepth(i)**4.0d0
4169 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4170 fac=fordepth(i)**4.0d0
4171 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4173 if (dhpb1(i).gt.0.0d0) then
4174 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4175 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4176 c write (iout,*) "alph nmr",
4177 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4180 C Get the force constant corresponding to this distance.
4182 C Calculate the contribution to energy.
4183 ehpb=ehpb+waga*rdis*rdis
4184 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4186 C Evaluate gradient.
4192 ggg(j)=fac*(c(j,jj)-c(j,ii))
4194 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4195 C If this is a SC-SC distance, we need to calculate the contributions to the
4196 C Cartesian gradient in the SC vectors (ghpbx).
4199 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4200 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4203 cgrad do j=iii,jjj-1
4205 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4209 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4210 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4214 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
4217 C--------------------------------------------------------------------------
4218 subroutine ssbond_ene(i,j,eij)
4220 C Calculate the distance and angle dependent SS-bond potential energy
4221 C using a free-energy function derived based on RHF/6-31G** ab initio
4222 C calculations of diethyl disulfide.
4224 C A. Liwo and U. Kozlowska, 11/24/03
4226 implicit real*8 (a-h,o-z)
4227 include 'DIMENSIONS'
4228 include 'COMMON.SBRIDGE'
4229 include 'COMMON.CHAIN'
4230 include 'COMMON.DERIV'
4231 include 'COMMON.LOCAL'
4232 include 'COMMON.INTERACT'
4233 include 'COMMON.VAR'
4234 include 'COMMON.IOUNITS'
4235 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4236 itypi=iabs(itype(i))
4240 dxi=dc_norm(1,nres+i)
4241 dyi=dc_norm(2,nres+i)
4242 dzi=dc_norm(3,nres+i)
4243 c dsci_inv=dsc_inv(itypi)
4244 dsci_inv=vbld_inv(nres+i)
4245 itypj=iabs(itype(j))
4246 c dscj_inv=dsc_inv(itypj)
4247 dscj_inv=vbld_inv(nres+j)
4251 dxj=dc_norm(1,nres+j)
4252 dyj=dc_norm(2,nres+j)
4253 dzj=dc_norm(3,nres+j)
4254 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4259 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4260 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4261 om12=dxi*dxj+dyi*dyj+dzi*dzj
4263 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4264 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4270 deltat12=om2-om1+2.0d0
4272 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4273 & +akct*deltad*deltat12
4274 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4275 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4276 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4277 c & " deltat12",deltat12," eij",eij
4278 ed=2*akcm*deltad+akct*deltat12
4280 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4281 eom1=-2*akth*deltat1-pom1-om2*pom2
4282 eom2= 2*akth*deltat2+pom1-om1*pom2
4285 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4286 ghpbx(k,i)=ghpbx(k,i)-ggk
4287 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4288 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4289 ghpbx(k,j)=ghpbx(k,j)+ggk
4290 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4291 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4292 ghpbc(k,i)=ghpbc(k,i)-ggk
4293 ghpbc(k,j)=ghpbc(k,j)+ggk
4296 C Calculate the components of the gradient in DC and X
4300 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4305 C--------------------------------------------------------------------------
4306 subroutine ebond(estr)
4308 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4310 implicit real*8 (a-h,o-z)
4311 include 'DIMENSIONS'
4312 include 'COMMON.LOCAL'
4313 include 'COMMON.GEO'
4314 include 'COMMON.INTERACT'
4315 include 'COMMON.DERIV'
4316 include 'COMMON.VAR'
4317 include 'COMMON.CHAIN'
4318 include 'COMMON.IOUNITS'
4319 include 'COMMON.NAMES'
4320 include 'COMMON.FFIELD'
4321 include 'COMMON.CONTROL'
4322 include 'COMMON.SETUP'
4323 double precision u(3),ud(3)
4326 do i=ibondp_start,ibondp_end
4327 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4328 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4330 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4331 & *dc(j,i-1)/vbld(i)
4333 if (energy_dec) write(iout,*)
4334 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4336 diff = vbld(i)-vbldp0
4337 if (energy_dec) write (iout,*)
4338 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4341 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4343 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4346 estr=0.5d0*AKP*estr+estr1
4348 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4350 do i=ibond_start,ibond_end
4352 if (iti.ne.10 .and. iti.ne.ntyp1) then
4355 diff=vbld(i+nres)-vbldsc0(1,iti)
4356 if (energy_dec) write (iout,*)
4357 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4358 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4359 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4361 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4365 diff=vbld(i+nres)-vbldsc0(j,iti)
4366 ud(j)=aksc(j,iti)*diff
4367 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4381 uprod2=uprod2*u(k)*u(k)
4385 usumsqder=usumsqder+ud(j)*uprod2
4387 estr=estr+uprod/usum
4389 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4397 C--------------------------------------------------------------------------
4398 subroutine ebend(etheta)
4400 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4401 C angles gamma and its derivatives in consecutive thetas and gammas.
4403 implicit real*8 (a-h,o-z)
4404 include 'DIMENSIONS'
4405 include 'COMMON.LOCAL'
4406 include 'COMMON.GEO'
4407 include 'COMMON.INTERACT'
4408 include 'COMMON.DERIV'
4409 include 'COMMON.VAR'
4410 include 'COMMON.CHAIN'
4411 include 'COMMON.IOUNITS'
4412 include 'COMMON.NAMES'
4413 include 'COMMON.FFIELD'
4414 include 'COMMON.CONTROL'
4415 common /calcthet/ term1,term2,termm,diffak,ratak,
4416 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4417 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4418 double precision y(2),z(2)
4420 c time11=dexp(-2*time)
4423 c write (*,'(a,i2)') 'EBEND ICG=',icg
4424 do i=ithet_start,ithet_end
4425 if (itype(i-1).eq.ntyp1) cycle
4426 C Zero the energy function and its derivative at 0 or pi.
4427 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4429 ichir1=isign(1,itype(i-2))
4430 ichir2=isign(1,itype(i))
4431 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4432 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4433 if (itype(i-1).eq.10) then
4434 itype1=isign(10,itype(i-2))
4435 ichir11=isign(1,itype(i-2))
4436 ichir12=isign(1,itype(i-2))
4437 itype2=isign(10,itype(i))
4438 ichir21=isign(1,itype(i))
4439 ichir22=isign(1,itype(i))
4442 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4445 if (phii.ne.phii) phii=150.0
4455 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4458 if (phii1.ne.phii1) phii1=150.0
4470 C Calculate the "mean" value of theta from the part of the distribution
4471 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4472 C In following comments this theta will be referred to as t_c.
4473 thet_pred_mean=0.0d0
4475 athetk=athet(k,it,ichir1,ichir2)
4476 bthetk=bthet(k,it,ichir1,ichir2)
4478 athetk=athet(k,itype1,ichir11,ichir12)
4479 bthetk=bthet(k,itype2,ichir21,ichir22)
4481 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4483 dthett=thet_pred_mean*ssd
4484 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4485 C Derivatives of the "mean" values in gamma1 and gamma2.
4486 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4487 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4488 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4489 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4491 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4492 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4493 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4494 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4496 if (theta(i).gt.pi-delta) then
4497 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4499 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4500 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4501 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4503 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4505 else if (theta(i).lt.delta) then
4506 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4507 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4508 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4510 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4511 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4514 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4517 etheta=etheta+ethetai
4518 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4520 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4521 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4522 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4524 C Ufff.... We've done all this!!!
4527 C---------------------------------------------------------------------------
4528 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4530 implicit real*8 (a-h,o-z)
4531 include 'DIMENSIONS'
4532 include 'COMMON.LOCAL'
4533 include 'COMMON.IOUNITS'
4534 common /calcthet/ term1,term2,termm,diffak,ratak,
4535 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4536 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4537 C Calculate the contributions to both Gaussian lobes.
4538 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4539 C The "polynomial part" of the "standard deviation" of this part of
4543 sig=sig*thet_pred_mean+polthet(j,it)
4545 C Derivative of the "interior part" of the "standard deviation of the"
4546 C gamma-dependent Gaussian lobe in t_c.
4547 sigtc=3*polthet(3,it)
4549 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4552 C Set the parameters of both Gaussian lobes of the distribution.
4553 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4554 fac=sig*sig+sigc0(it)
4557 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4558 sigsqtc=-4.0D0*sigcsq*sigtc
4559 c print *,i,sig,sigtc,sigsqtc
4560 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4561 sigtc=-sigtc/(fac*fac)
4562 C Following variable is sigma(t_c)**(-2)
4563 sigcsq=sigcsq*sigcsq
4565 sig0inv=1.0D0/sig0i**2
4566 delthec=thetai-thet_pred_mean
4567 delthe0=thetai-theta0i
4568 term1=-0.5D0*sigcsq*delthec*delthec
4569 term2=-0.5D0*sig0inv*delthe0*delthe0
4570 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4571 C NaNs in taking the logarithm. We extract the largest exponent which is added
4572 C to the energy (this being the log of the distribution) at the end of energy
4573 C term evaluation for this virtual-bond angle.
4574 if (term1.gt.term2) then
4576 term2=dexp(term2-termm)
4580 term1=dexp(term1-termm)
4583 C The ratio between the gamma-independent and gamma-dependent lobes of
4584 C the distribution is a Gaussian function of thet_pred_mean too.
4585 diffak=gthet(2,it)-thet_pred_mean
4586 ratak=diffak/gthet(3,it)**2
4587 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4588 C Let's differentiate it in thet_pred_mean NOW.
4590 C Now put together the distribution terms to make complete distribution.
4591 termexp=term1+ak*term2
4592 termpre=sigc+ak*sig0i
4593 C Contribution of the bending energy from this theta is just the -log of
4594 C the sum of the contributions from the two lobes and the pre-exponential
4595 C factor. Simple enough, isn't it?
4596 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4597 C NOW the derivatives!!!
4598 C 6/6/97 Take into account the deformation.
4599 E_theta=(delthec*sigcsq*term1
4600 & +ak*delthe0*sig0inv*term2)/termexp
4601 E_tc=((sigtc+aktc*sig0i)/termpre
4602 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4603 & aktc*term2)/termexp)
4606 c-----------------------------------------------------------------------------
4607 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4608 implicit real*8 (a-h,o-z)
4609 include 'DIMENSIONS'
4610 include 'COMMON.LOCAL'
4611 include 'COMMON.IOUNITS'
4612 common /calcthet/ term1,term2,termm,diffak,ratak,
4613 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4614 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4615 delthec=thetai-thet_pred_mean
4616 delthe0=thetai-theta0i
4617 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4618 t3 = thetai-thet_pred_mean
4622 t14 = t12+t6*sigsqtc
4624 t21 = thetai-theta0i
4630 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4631 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4632 & *(-t12*t9-ak*sig0inv*t27)
4636 C--------------------------------------------------------------------------
4637 subroutine ebend(etheta)
4639 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4640 C angles gamma and its derivatives in consecutive thetas and gammas.
4641 C ab initio-derived potentials from
4642 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4644 implicit real*8 (a-h,o-z)
4645 include 'DIMENSIONS'
4646 include 'COMMON.LOCAL'
4647 include 'COMMON.GEO'
4648 include 'COMMON.INTERACT'
4649 include 'COMMON.DERIV'
4650 include 'COMMON.VAR'
4651 include 'COMMON.CHAIN'
4652 include 'COMMON.IOUNITS'
4653 include 'COMMON.NAMES'
4654 include 'COMMON.FFIELD'
4655 include 'COMMON.CONTROL'
4656 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4657 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4658 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4659 & sinph1ph2(maxdouble,maxdouble)
4660 logical lprn /.false./, lprn1 /.false./
4662 do i=ithet_start,ithet_end
4663 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4664 &(itype(i).eq.ntyp1)) cycle
4665 C print *,i,theta(i)
4666 if (iabs(itype(i+1)).eq.20) iblock=2
4667 if (iabs(itype(i+1)).ne.20) iblock=1
4671 theti2=0.5d0*theta(i)
4672 ityp2=ithetyp((itype(i-1)))
4674 coskt(k)=dcos(k*theti2)
4675 sinkt(k)=dsin(k*theti2)
4679 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4682 if (phii.ne.phii) phii=150.0
4686 ityp1=ithetyp((itype(i-2)))
4687 C propagation of chirality for glycine type
4689 cosph1(k)=dcos(k*phii)
4690 sinph1(k)=dsin(k*phii)
4695 ityp1=ithetyp((itype(i-2)))
4700 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4703 if (phii1.ne.phii1) phii1=150.0
4708 ityp3=ithetyp((itype(i)))
4710 cosph2(k)=dcos(k*phii1)
4711 sinph2(k)=dsin(k*phii1)
4715 ityp3=ithetyp((itype(i)))
4721 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4724 ccl=cosph1(l)*cosph2(k-l)
4725 ssl=sinph1(l)*sinph2(k-l)
4726 scl=sinph1(l)*cosph2(k-l)
4727 csl=cosph1(l)*sinph2(k-l)
4728 cosph1ph2(l,k)=ccl-ssl
4729 cosph1ph2(k,l)=ccl+ssl
4730 sinph1ph2(l,k)=scl+csl
4731 sinph1ph2(k,l)=scl-csl
4735 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4736 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4737 write (iout,*) "coskt and sinkt"
4739 write (iout,*) k,coskt(k),sinkt(k)
4743 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4744 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4747 & write (iout,*) "k",k,"
4748 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4749 & " ethetai",ethetai
4752 write (iout,*) "cosph and sinph"
4754 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4756 write (iout,*) "cosph1ph2 and sinph2ph2"
4759 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4760 & sinph1ph2(l,k),sinph1ph2(k,l)
4763 write(iout,*) "ethetai",ethetai
4768 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4769 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4770 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4771 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4772 ethetai=ethetai+sinkt(m)*aux
4773 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4774 dephii=dephii+k*sinkt(m)*(
4775 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4776 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4777 dephii1=dephii1+k*sinkt(m)*(
4778 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4779 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4781 & write (iout,*) "m",m," k",k," bbthet",
4782 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4783 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4784 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4785 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4786 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4789 C print *,"cosph1", (cosph1(k), k=1,nsingle)
4790 C print *,"cosph2", (cosph2(k), k=1,nsingle)
4791 C print *,"sinph1", (sinph1(k), k=1,nsingle)
4792 C print *,"sinph2", (sinph2(k), k=1,nsingle)
4794 & write(iout,*) "ethetai",ethetai
4795 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4799 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4800 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4801 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4802 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4803 ethetai=ethetai+sinkt(m)*aux
4804 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4805 dephii=dephii+l*sinkt(m)*(
4806 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4807 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4808 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4809 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4810 dephii1=dephii1+(k-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))
4816 write (iout,*) "m",m," k",k," l",l," ffthet",
4817 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4818 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4819 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4820 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4821 & " ethetai",ethetai
4822 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4823 & cosph1ph2(k,l)*sinkt(m),
4824 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4833 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4834 & i,theta(i)*rad2deg,phii*rad2deg,
4835 & phii1*rad2deg,ethetai
4837 etheta=etheta+ethetai
4838 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4839 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4840 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4846 c-----------------------------------------------------------------------------
4847 subroutine esc(escloc)
4848 C Calculate the local energy of a side chain and its derivatives in the
4849 C corresponding virtual-bond valence angles THETA and the spherical angles
4851 implicit real*8 (a-h,o-z)
4852 include 'DIMENSIONS'
4853 include 'COMMON.GEO'
4854 include 'COMMON.LOCAL'
4855 include 'COMMON.VAR'
4856 include 'COMMON.INTERACT'
4857 include 'COMMON.DERIV'
4858 include 'COMMON.CHAIN'
4859 include 'COMMON.IOUNITS'
4860 include 'COMMON.NAMES'
4861 include 'COMMON.FFIELD'
4862 include 'COMMON.CONTROL'
4863 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4864 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4865 common /sccalc/ time11,time12,time112,theti,it,nlobit
4868 c write (iout,'(a)') 'ESC'
4869 do i=loc_start,loc_end
4871 if (it.eq.ntyp1) cycle
4872 if (it.eq.10) goto 1
4873 nlobit=nlob(iabs(it))
4874 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4875 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4876 theti=theta(i+1)-pipol
4881 if (x(2).gt.pi-delta) then
4885 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4887 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4888 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4890 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4891 & ddersc0(1),dersc(1))
4892 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4893 & ddersc0(3),dersc(3))
4895 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4897 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4898 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4899 & dersc0(2),esclocbi,dersc02)
4900 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4902 call splinthet(x(2),0.5d0*delta,ss,ssd)
4907 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4909 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4910 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4912 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4914 c write (iout,*) escloci
4915 else if (x(2).lt.delta) then
4919 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4921 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4922 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4924 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4925 & ddersc0(1),dersc(1))
4926 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4927 & ddersc0(3),dersc(3))
4929 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4931 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4932 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4933 & dersc0(2),esclocbi,dersc02)
4934 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4939 call splinthet(x(2),0.5d0*delta,ss,ssd)
4941 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4943 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4944 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4946 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4947 c write (iout,*) escloci
4949 call enesc(x,escloci,dersc,ddummy,.false.)
4952 escloc=escloc+escloci
4953 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4954 & 'escloc',i,escloci
4955 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4957 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4959 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4960 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4965 C---------------------------------------------------------------------------
4966 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4967 implicit real*8 (a-h,o-z)
4968 include 'DIMENSIONS'
4969 include 'COMMON.GEO'
4970 include 'COMMON.LOCAL'
4971 include 'COMMON.IOUNITS'
4972 common /sccalc/ time11,time12,time112,theti,it,nlobit
4973 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4974 double precision contr(maxlob,-1:1)
4976 c write (iout,*) 'it=',it,' nlobit=',nlobit
4980 if (mixed) ddersc(j)=0.0d0
4984 C Because of periodicity of the dependence of the SC energy in omega we have
4985 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4986 C To avoid underflows, first compute & store the exponents.
4994 z(k)=x(k)-censc(k,j,it)
4999 Axk=Axk+gaussc(l,k,j,it)*z(l)
5005 expfac=expfac+Ax(k,j,iii)*z(k)
5013 C As in the case of ebend, we want to avoid underflows in exponentiation and
5014 C subsequent NaNs and INFs in energy calculation.
5015 C Find the largest exponent
5019 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5023 cd print *,'it=',it,' emin=',emin
5025 C Compute the contribution to SC energy and derivatives
5030 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5031 if(adexp.ne.adexp) adexp=1.0
5034 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5036 cd print *,'j=',j,' expfac=',expfac
5037 escloc_i=escloc_i+expfac
5039 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5043 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5044 & +gaussc(k,2,j,it))*expfac
5051 dersc(1)=dersc(1)/cos(theti)**2
5052 ddersc(1)=ddersc(1)/cos(theti)**2
5055 escloci=-(dlog(escloc_i)-emin)
5057 dersc(j)=dersc(j)/escloc_i
5061 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5066 C------------------------------------------------------------------------------
5067 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5068 implicit real*8 (a-h,o-z)
5069 include 'DIMENSIONS'
5070 include 'COMMON.GEO'
5071 include 'COMMON.LOCAL'
5072 include 'COMMON.IOUNITS'
5073 common /sccalc/ time11,time12,time112,theti,it,nlobit
5074 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5075 double precision contr(maxlob)
5086 z(k)=x(k)-censc(k,j,it)
5092 Axk=Axk+gaussc(l,k,j,it)*z(l)
5098 expfac=expfac+Ax(k,j)*z(k)
5103 C As in the case of ebend, we want to avoid underflows in exponentiation and
5104 C subsequent NaNs and INFs in energy calculation.
5105 C Find the largest exponent
5108 if (emin.gt.contr(j)) emin=contr(j)
5112 C Compute the contribution to SC energy and derivatives
5116 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5117 escloc_i=escloc_i+expfac
5119 dersc(k)=dersc(k)+Ax(k,j)*expfac
5121 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5122 & +gaussc(1,2,j,it))*expfac
5126 dersc(1)=dersc(1)/cos(theti)**2
5127 dersc12=dersc12/cos(theti)**2
5128 escloci=-(dlog(escloc_i)-emin)
5130 dersc(j)=dersc(j)/escloc_i
5132 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5136 c----------------------------------------------------------------------------------
5137 subroutine esc(escloc)
5138 C Calculate the local energy of a side chain and its derivatives in the
5139 C corresponding virtual-bond valence angles THETA and the spherical angles
5140 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5141 C added by Urszula Kozlowska. 07/11/2007
5143 implicit real*8 (a-h,o-z)
5144 include 'DIMENSIONS'
5145 include 'COMMON.GEO'
5146 include 'COMMON.LOCAL'
5147 include 'COMMON.VAR'
5148 include 'COMMON.SCROT'
5149 include 'COMMON.INTERACT'
5150 include 'COMMON.DERIV'
5151 include 'COMMON.CHAIN'
5152 include 'COMMON.IOUNITS'
5153 include 'COMMON.NAMES'
5154 include 'COMMON.FFIELD'
5155 include 'COMMON.CONTROL'
5156 include 'COMMON.VECTORS'
5157 double precision x_prime(3),y_prime(3),z_prime(3)
5158 & , sumene,dsc_i,dp2_i,x(65),
5159 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5160 & de_dxx,de_dyy,de_dzz,de_dt
5161 double precision s1_t,s1_6_t,s2_t,s2_6_t
5163 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5164 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5165 & dt_dCi(3),dt_dCi1(3)
5166 common /sccalc/ time11,time12,time112,theti,it,nlobit
5169 do i=loc_start,loc_end
5170 if (itype(i).eq.ntyp1) cycle
5171 costtab(i+1) =dcos(theta(i+1))
5172 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5173 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5174 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5175 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5176 cosfac=dsqrt(cosfac2)
5177 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5178 sinfac=dsqrt(sinfac2)
5180 if (it.eq.10) goto 1
5182 C Compute the axes of tghe local cartesian coordinates system; store in
5183 c x_prime, y_prime and z_prime
5190 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5191 C & dc_norm(3,i+nres)
5193 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5194 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5197 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5200 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5201 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5202 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5203 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5204 c & " xy",scalar(x_prime(1),y_prime(1)),
5205 c & " xz",scalar(x_prime(1),z_prime(1)),
5206 c & " yy",scalar(y_prime(1),y_prime(1)),
5207 c & " yz",scalar(y_prime(1),z_prime(1)),
5208 c & " zz",scalar(z_prime(1),z_prime(1))
5210 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5211 C to local coordinate system. Store in xx, yy, zz.
5217 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5218 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5219 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5226 C Compute the energy of the ith side cbain
5228 c write (2,*) "xx",xx," yy",yy," zz",zz
5231 x(j) = sc_parmin(j,it)
5234 Cc diagnostics - remove later
5236 yy1 = dsin(alph(2))*dcos(omeg(2))
5237 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5238 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5239 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5241 C," --- ", xx_w,yy_w,zz_w
5244 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5245 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5247 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5248 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5250 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5251 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5252 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5253 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5254 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5256 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5257 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5258 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5259 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5260 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5262 dsc_i = 0.743d0+x(61)
5264 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5265 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5266 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5267 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5268 s1=(1+x(63))/(0.1d0 + dscp1)
5269 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5270 s2=(1+x(65))/(0.1d0 + dscp2)
5271 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5272 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5273 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5274 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5276 c & dscp1,dscp2,sumene
5277 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5278 escloc = escloc + sumene
5279 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5284 C This section to check the numerical derivatives of the energy of ith side
5285 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5286 C #define DEBUG in the code to turn it on.
5288 write (2,*) "sumene =",sumene
5292 write (2,*) xx,yy,zz
5293 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5294 de_dxx_num=(sumenep-sumene)/aincr
5296 write (2,*) "xx+ sumene from enesc=",sumenep
5299 write (2,*) xx,yy,zz
5300 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5301 de_dyy_num=(sumenep-sumene)/aincr
5303 write (2,*) "yy+ sumene from enesc=",sumenep
5306 write (2,*) xx,yy,zz
5307 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5308 de_dzz_num=(sumenep-sumene)/aincr
5310 write (2,*) "zz+ sumene from enesc=",sumenep
5311 costsave=cost2tab(i+1)
5312 sintsave=sint2tab(i+1)
5313 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5314 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5315 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5316 de_dt_num=(sumenep-sumene)/aincr
5317 write (2,*) " t+ sumene from enesc=",sumenep
5318 cost2tab(i+1)=costsave
5319 sint2tab(i+1)=sintsave
5320 C End of diagnostics section.
5323 C Compute the gradient of esc
5325 c zz=zz*dsign(1.0,dfloat(itype(i)))
5326 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5327 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5328 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5329 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5330 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5331 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5332 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5333 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5334 pom1=(sumene3*sint2tab(i+1)+sumene1)
5335 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5336 pom2=(sumene4*cost2tab(i+1)+sumene2)
5337 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5338 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5339 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5340 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5342 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5343 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5344 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5346 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5347 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5348 & +(pom1+pom2)*pom_dx
5350 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5353 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5354 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5355 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5357 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5358 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5359 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5360 & +x(59)*zz**2 +x(60)*xx*zz
5361 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5362 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5363 & +(pom1-pom2)*pom_dy
5365 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5368 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5369 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5370 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5371 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5372 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5373 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5374 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5375 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5377 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5380 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5381 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5382 & +pom1*pom_dt1+pom2*pom_dt2
5384 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5389 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5390 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5391 cosfac2xx=cosfac2*xx
5392 sinfac2yy=sinfac2*yy
5394 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5396 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5398 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5399 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5400 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5401 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5402 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5403 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5404 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5405 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5406 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5407 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5411 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5412 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5413 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5414 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5417 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5418 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5419 dZZ_XYZ(k)=vbld_inv(i+nres)*
5420 & (z_prime(k)-zz*dC_norm(k,i+nres))
5422 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5423 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5427 dXX_Ctab(k,i)=dXX_Ci(k)
5428 dXX_C1tab(k,i)=dXX_Ci1(k)
5429 dYY_Ctab(k,i)=dYY_Ci(k)
5430 dYY_C1tab(k,i)=dYY_Ci1(k)
5431 dZZ_Ctab(k,i)=dZZ_Ci(k)
5432 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5433 dXX_XYZtab(k,i)=dXX_XYZ(k)
5434 dYY_XYZtab(k,i)=dYY_XYZ(k)
5435 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5439 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5440 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5441 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5442 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5443 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5445 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5446 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5447 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5448 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5449 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5450 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5451 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5452 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5454 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5455 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5457 C to check gradient call subroutine check_grad
5463 c------------------------------------------------------------------------------
5464 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5466 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5467 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5468 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5469 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5471 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5472 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5474 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5475 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5476 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5477 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5478 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5480 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5481 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5482 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5483 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5484 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5486 dsc_i = 0.743d0+x(61)
5488 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5489 & *(xx*cost2+yy*sint2))
5490 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5491 & *(xx*cost2-yy*sint2))
5492 s1=(1+x(63))/(0.1d0 + dscp1)
5493 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5494 s2=(1+x(65))/(0.1d0 + dscp2)
5495 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5496 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5497 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5502 c------------------------------------------------------------------------------
5503 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5505 C This procedure calculates two-body contact function g(rij) and its derivative:
5508 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5511 C where x=(rij-r0ij)/delta
5513 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5516 double precision rij,r0ij,eps0ij,fcont,fprimcont
5517 double precision x,x2,x4,delta
5521 if (x.lt.-1.0D0) then
5524 else if (x.le.1.0D0) then
5527 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5528 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5535 c------------------------------------------------------------------------------
5536 subroutine splinthet(theti,delta,ss,ssder)
5537 implicit real*8 (a-h,o-z)
5538 include 'DIMENSIONS'
5539 include 'COMMON.VAR'
5540 include 'COMMON.GEO'
5543 if (theti.gt.pipol) then
5544 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5546 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5551 c------------------------------------------------------------------------------
5552 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5554 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5555 double precision ksi,ksi2,ksi3,a1,a2,a3
5556 a1=fprim0*delta/(f1-f0)
5562 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5563 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5566 c------------------------------------------------------------------------------
5567 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5569 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5570 double precision ksi,ksi2,ksi3,a1,a2,a3
5575 a2=3*(f1x-f0x)-2*fprim0x*delta
5576 a3=fprim0x*delta-2*(f1x-f0x)
5577 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5580 C-----------------------------------------------------------------------------
5582 C-----------------------------------------------------------------------------
5583 subroutine etor(etors,edihcnstr)
5584 implicit real*8 (a-h,o-z)
5585 include 'DIMENSIONS'
5586 include 'COMMON.VAR'
5587 include 'COMMON.GEO'
5588 include 'COMMON.LOCAL'
5589 include 'COMMON.TORSION'
5590 include 'COMMON.INTERACT'
5591 include 'COMMON.DERIV'
5592 include 'COMMON.CHAIN'
5593 include 'COMMON.NAMES'
5594 include 'COMMON.IOUNITS'
5595 include 'COMMON.FFIELD'
5596 include 'COMMON.TORCNSTR'
5597 include 'COMMON.CONTROL'
5599 C Set lprn=.true. for debugging
5603 do i=iphi_start,iphi_end
5605 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5606 & .or. itype(i).eq.ntyp1) cycle
5607 itori=itortyp(itype(i-2))
5608 itori1=itortyp(itype(i-1))
5611 C Proline-Proline pair is a special case...
5612 if (itori.eq.3 .and. itori1.eq.3) then
5613 if (phii.gt.-dwapi3) then
5615 fac=1.0D0/(1.0D0-cosphi)
5616 etorsi=v1(1,3,3)*fac
5617 etorsi=etorsi+etorsi
5618 etors=etors+etorsi-v1(1,3,3)
5619 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5620 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5623 v1ij=v1(j+1,itori,itori1)
5624 v2ij=v2(j+1,itori,itori1)
5627 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5628 if (energy_dec) etors_ii=etors_ii+
5629 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5630 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5634 v1ij=v1(j,itori,itori1)
5635 v2ij=v2(j,itori,itori1)
5638 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5639 if (energy_dec) etors_ii=etors_ii+
5640 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5641 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5644 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5647 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5648 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5649 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5650 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5651 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5653 ! 6/20/98 - dihedral angle constraints
5656 itori=idih_constr(i)
5659 if (difi.gt.drange(i)) then
5661 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5662 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5663 else if (difi.lt.-drange(i)) then
5665 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5666 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5668 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5669 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5671 ! write (iout,*) 'edihcnstr',edihcnstr
5674 c------------------------------------------------------------------------------
5675 subroutine etor_d(etors_d)
5679 c----------------------------------------------------------------------------
5681 subroutine etor(etors,edihcnstr)
5682 implicit real*8 (a-h,o-z)
5683 include 'DIMENSIONS'
5684 include 'COMMON.VAR'
5685 include 'COMMON.GEO'
5686 include 'COMMON.LOCAL'
5687 include 'COMMON.TORSION'
5688 include 'COMMON.INTERACT'
5689 include 'COMMON.DERIV'
5690 include 'COMMON.CHAIN'
5691 include 'COMMON.NAMES'
5692 include 'COMMON.IOUNITS'
5693 include 'COMMON.FFIELD'
5694 include 'COMMON.TORCNSTR'
5695 include 'COMMON.CONTROL'
5697 C Set lprn=.true. for debugging
5701 do i=iphi_start,iphi_end
5702 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5703 & .or. itype(i).eq.ntyp1) cycle
5705 if (iabs(itype(i)).eq.20) then
5710 itori=itortyp(itype(i-2))
5711 itori1=itortyp(itype(i-1))
5714 C Regular cosine and sine terms
5715 do j=1,nterm(itori,itori1,iblock)
5716 v1ij=v1(j,itori,itori1,iblock)
5717 v2ij=v2(j,itori,itori1,iblock)
5720 etors=etors+v1ij*cosphi+v2ij*sinphi
5721 if (energy_dec) etors_ii=etors_ii+
5722 & v1ij*cosphi+v2ij*sinphi
5723 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5727 C E = SUM ----------------------------------- - v1
5728 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5730 cosphi=dcos(0.5d0*phii)
5731 sinphi=dsin(0.5d0*phii)
5732 do j=1,nlor(itori,itori1,iblock)
5733 vl1ij=vlor1(j,itori,itori1)
5734 vl2ij=vlor2(j,itori,itori1)
5735 vl3ij=vlor3(j,itori,itori1)
5736 pom=vl2ij*cosphi+vl3ij*sinphi
5737 pom1=1.0d0/(pom*pom+1.0d0)
5738 etors=etors+vl1ij*pom1
5739 if (energy_dec) etors_ii=etors_ii+
5742 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5744 C Subtract the constant term
5745 etors=etors-v0(itori,itori1,iblock)
5746 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5747 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5749 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5750 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5751 & (v1(j,itori,itori1,iblock),j=1,6),
5752 & (v2(j,itori,itori1,iblock),j=1,6)
5753 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5754 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5756 ! 6/20/98 - dihedral angle constraints
5758 c do i=1,ndih_constr
5759 do i=idihconstr_start,idihconstr_end
5760 itori=idih_constr(i)
5762 difi=pinorm(phii-phi0(i))
5763 if (difi.gt.drange(i)) then
5765 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5766 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5767 else if (difi.lt.-drange(i)) then
5769 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5770 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5774 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5775 cd & rad2deg*phi0(i), rad2deg*drange(i),
5776 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5778 cd write (iout,*) 'edihcnstr',edihcnstr
5781 c----------------------------------------------------------------------------
5782 subroutine etor_d(etors_d)
5783 C 6/23/01 Compute double torsional energy
5784 implicit real*8 (a-h,o-z)
5785 include 'DIMENSIONS'
5786 include 'COMMON.VAR'
5787 include 'COMMON.GEO'
5788 include 'COMMON.LOCAL'
5789 include 'COMMON.TORSION'
5790 include 'COMMON.INTERACT'
5791 include 'COMMON.DERIV'
5792 include 'COMMON.CHAIN'
5793 include 'COMMON.NAMES'
5794 include 'COMMON.IOUNITS'
5795 include 'COMMON.FFIELD'
5796 include 'COMMON.TORCNSTR'
5798 C Set lprn=.true. for debugging
5802 c write(iout,*) "a tu??"
5803 do i=iphid_start,iphid_end
5804 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5805 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5806 itori=itortyp(itype(i-2))
5807 itori1=itortyp(itype(i-1))
5808 itori2=itortyp(itype(i))
5814 if (iabs(itype(i+1)).eq.20) iblock=2
5816 C Regular cosine and sine terms
5817 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5818 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5819 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5820 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5821 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5822 cosphi1=dcos(j*phii)
5823 sinphi1=dsin(j*phii)
5824 cosphi2=dcos(j*phii1)
5825 sinphi2=dsin(j*phii1)
5826 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5827 & v2cij*cosphi2+v2sij*sinphi2
5828 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5829 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5831 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5833 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5834 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5835 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5836 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5837 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5838 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5839 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5840 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5841 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5842 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5843 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5844 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5845 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5846 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5849 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5850 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5855 c------------------------------------------------------------------------------
5856 subroutine eback_sc_corr(esccor)
5857 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5858 c conformational states; temporarily implemented as differences
5859 c between UNRES torsional potentials (dependent on three types of
5860 c residues) and the torsional potentials dependent on all 20 types
5861 c of residues computed from AM1 energy surfaces of terminally-blocked
5862 c amino-acid residues.
5863 implicit real*8 (a-h,o-z)
5864 include 'DIMENSIONS'
5865 include 'COMMON.VAR'
5866 include 'COMMON.GEO'
5867 include 'COMMON.LOCAL'
5868 include 'COMMON.TORSION'
5869 include 'COMMON.SCCOR'
5870 include 'COMMON.INTERACT'
5871 include 'COMMON.DERIV'
5872 include 'COMMON.CHAIN'
5873 include 'COMMON.NAMES'
5874 include 'COMMON.IOUNITS'
5875 include 'COMMON.FFIELD'
5876 include 'COMMON.CONTROL'
5878 C Set lprn=.true. for debugging
5881 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5883 do i=itau_start,itau_end
5884 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5886 isccori=isccortyp(itype(i-2))
5887 isccori1=isccortyp(itype(i-1))
5888 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5890 do intertyp=1,3 !intertyp
5891 cc Added 09 May 2012 (Adasko)
5892 cc Intertyp means interaction type of backbone mainchain correlation:
5893 c 1 = SC...Ca...Ca...Ca
5894 c 2 = Ca...Ca...Ca...SC
5895 c 3 = SC...Ca...Ca...SCi
5897 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5898 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5899 & (itype(i-1).eq.ntyp1)))
5900 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5901 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5902 & .or.(itype(i).eq.ntyp1)))
5903 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5904 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5905 & (itype(i-3).eq.ntyp1)))) cycle
5906 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5907 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5909 do j=1,nterm_sccor(isccori,isccori1)
5910 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5911 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5912 cosphi=dcos(j*tauangle(intertyp,i))
5913 sinphi=dsin(j*tauangle(intertyp,i))
5914 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5915 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5917 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5918 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5920 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5921 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
5922 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
5923 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5924 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5930 c----------------------------------------------------------------------------
5931 subroutine multibody(ecorr)
5932 C This subroutine calculates multi-body contributions to energy following
5933 C the idea of Skolnick et al. If side chains I and J make a contact and
5934 C at the same time side chains I+1 and J+1 make a contact, an extra
5935 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5936 implicit real*8 (a-h,o-z)
5937 include 'DIMENSIONS'
5938 include 'COMMON.IOUNITS'
5939 include 'COMMON.DERIV'
5940 include 'COMMON.INTERACT'
5941 include 'COMMON.CONTACTS'
5942 double precision gx(3),gx1(3)
5945 C Set lprn=.true. for debugging
5949 write (iout,'(a)') 'Contact function values:'
5951 write (iout,'(i2,20(1x,i2,f10.5))')
5952 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5967 num_conti=num_cont(i)
5968 num_conti1=num_cont(i1)
5973 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5974 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5975 cd & ' ishift=',ishift
5976 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5977 C The system gains extra energy.
5978 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5979 endif ! j1==j+-ishift
5988 c------------------------------------------------------------------------------
5989 double precision function esccorr(i,j,k,l,jj,kk)
5990 implicit real*8 (a-h,o-z)
5991 include 'DIMENSIONS'
5992 include 'COMMON.IOUNITS'
5993 include 'COMMON.DERIV'
5994 include 'COMMON.INTERACT'
5995 include 'COMMON.CONTACTS'
5996 double precision gx(3),gx1(3)
6001 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6002 C Calculate the multi-body contribution to energy.
6003 C Calculate multi-body contributions to the gradient.
6004 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6005 cd & k,l,(gacont(m,kk,k),m=1,3)
6007 gx(m) =ekl*gacont(m,jj,i)
6008 gx1(m)=eij*gacont(m,kk,k)
6009 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6010 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6011 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6012 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6016 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6021 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6027 c------------------------------------------------------------------------------
6028 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6029 C This subroutine calculates multi-body contributions to hydrogen-bonding
6030 implicit real*8 (a-h,o-z)
6031 include 'DIMENSIONS'
6032 include 'COMMON.IOUNITS'
6035 parameter (max_cont=maxconts)
6036 parameter (max_dim=26)
6037 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6038 double precision zapas(max_dim,maxconts,max_fg_procs),
6039 & zapas_recv(max_dim,maxconts,max_fg_procs)
6040 common /przechowalnia/ zapas
6041 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6042 & status_array(MPI_STATUS_SIZE,maxconts*2)
6044 include 'COMMON.SETUP'
6045 include 'COMMON.FFIELD'
6046 include 'COMMON.DERIV'
6047 include 'COMMON.INTERACT'
6048 include 'COMMON.CONTACTS'
6049 include 'COMMON.CONTROL'
6050 include 'COMMON.LOCAL'
6051 double precision gx(3),gx1(3),time00
6054 C Set lprn=.true. for debugging
6059 if (nfgtasks.le.1) goto 30
6061 write (iout,'(a)') 'Contact function values before RECEIVE:'
6063 write (iout,'(2i3,50(1x,i2,f5.2))')
6064 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6065 & j=1,num_cont_hb(i))
6069 do i=1,ntask_cont_from
6072 do i=1,ntask_cont_to
6075 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6077 C Make the list of contacts to send to send to other procesors
6078 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6080 do i=iturn3_start,iturn3_end
6081 c write (iout,*) "make contact list turn3",i," num_cont",
6083 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6085 do i=iturn4_start,iturn4_end
6086 c write (iout,*) "make contact list turn4",i," num_cont",
6088 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6092 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6094 do j=1,num_cont_hb(i)
6097 iproc=iint_sent_local(k,jjc,ii)
6098 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6099 if (iproc.gt.0) then
6100 ncont_sent(iproc)=ncont_sent(iproc)+1
6101 nn=ncont_sent(iproc)
6103 zapas(2,nn,iproc)=jjc
6104 zapas(3,nn,iproc)=facont_hb(j,i)
6105 zapas(4,nn,iproc)=ees0p(j,i)
6106 zapas(5,nn,iproc)=ees0m(j,i)
6107 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6108 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6109 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6110 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6111 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6112 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6113 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6114 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6115 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6116 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6117 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6118 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6119 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6120 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6121 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6122 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6123 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6124 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6125 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6126 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6127 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6134 & "Numbers of contacts to be sent to other processors",
6135 & (ncont_sent(i),i=1,ntask_cont_to)
6136 write (iout,*) "Contacts sent"
6137 do ii=1,ntask_cont_to
6139 iproc=itask_cont_to(ii)
6140 write (iout,*) nn," contacts to processor",iproc,
6141 & " of CONT_TO_COMM group"
6143 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6151 CorrelID1=nfgtasks+fg_rank+1
6153 C Receive the numbers of needed contacts from other processors
6154 do ii=1,ntask_cont_from
6155 iproc=itask_cont_from(ii)
6157 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6158 & FG_COMM,req(ireq),IERR)
6160 c write (iout,*) "IRECV ended"
6162 C Send the number of contacts needed by other processors
6163 do ii=1,ntask_cont_to
6164 iproc=itask_cont_to(ii)
6166 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6167 & FG_COMM,req(ireq),IERR)
6169 c write (iout,*) "ISEND ended"
6170 c write (iout,*) "number of requests (nn)",ireq
6173 & call MPI_Waitall(ireq,req,status_array,ierr)
6175 c & "Numbers of contacts to be received from other processors",
6176 c & (ncont_recv(i),i=1,ntask_cont_from)
6180 do ii=1,ntask_cont_from
6181 iproc=itask_cont_from(ii)
6183 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6184 c & " of CONT_TO_COMM group"
6188 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6189 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6190 c write (iout,*) "ireq,req",ireq,req(ireq)
6193 C Send the contacts to processors that need them
6194 do ii=1,ntask_cont_to
6195 iproc=itask_cont_to(ii)
6197 c write (iout,*) nn," contacts to processor",iproc,
6198 c & " of CONT_TO_COMM group"
6201 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6202 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6203 c write (iout,*) "ireq,req",ireq,req(ireq)
6205 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6209 c write (iout,*) "number of requests (contacts)",ireq
6210 c write (iout,*) "req",(req(i),i=1,4)
6213 & call MPI_Waitall(ireq,req,status_array,ierr)
6214 do iii=1,ntask_cont_from
6215 iproc=itask_cont_from(iii)
6218 write (iout,*) "Received",nn," contacts from processor",iproc,
6219 & " of CONT_FROM_COMM group"
6222 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6227 ii=zapas_recv(1,i,iii)
6228 c Flag the received contacts to prevent double-counting
6229 jj=-zapas_recv(2,i,iii)
6230 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6232 nnn=num_cont_hb(ii)+1
6235 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6236 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6237 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6238 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6239 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6240 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6241 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6242 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6243 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6244 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6245 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6246 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6247 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6248 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6249 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6250 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6251 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6252 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6253 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6254 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6255 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6256 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6257 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6258 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6263 write (iout,'(a)') 'Contact function values after receive:'
6265 write (iout,'(2i3,50(1x,i3,f5.2))')
6266 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6267 & j=1,num_cont_hb(i))
6274 write (iout,'(a)') 'Contact function values:'
6276 write (iout,'(2i3,50(1x,i3,f5.2))')
6277 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6278 & j=1,num_cont_hb(i))
6282 C Remove the loop below after debugging !!!
6289 C Calculate the local-electrostatic correlation terms
6290 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6292 num_conti=num_cont_hb(i)
6293 num_conti1=num_cont_hb(i+1)
6300 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6301 c & ' jj=',jj,' kk=',kk
6302 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6303 & .or. j.lt.0 .and. j1.gt.0) .and.
6304 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6305 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6306 C The system gains extra energy.
6307 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6308 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6309 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6311 else if (j1.eq.j) then
6312 C Contacts I-J and I-(J+1) occur simultaneously.
6313 C The system loses extra energy.
6314 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6319 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6320 c & ' jj=',jj,' kk=',kk
6322 C Contacts I-J and (I+1)-J occur simultaneously.
6323 C The system loses extra energy.
6324 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6331 c------------------------------------------------------------------------------
6332 subroutine add_hb_contact(ii,jj,itask)
6333 implicit real*8 (a-h,o-z)
6334 include "DIMENSIONS"
6335 include "COMMON.IOUNITS"
6338 parameter (max_cont=maxconts)
6339 parameter (max_dim=26)
6340 include "COMMON.CONTACTS"
6341 double precision zapas(max_dim,maxconts,max_fg_procs),
6342 & zapas_recv(max_dim,maxconts,max_fg_procs)
6343 common /przechowalnia/ zapas
6344 integer i,j,ii,jj,iproc,itask(4),nn
6345 c write (iout,*) "itask",itask
6348 if (iproc.gt.0) then
6349 do j=1,num_cont_hb(ii)
6351 c write (iout,*) "i",ii," j",jj," jjc",jjc
6353 ncont_sent(iproc)=ncont_sent(iproc)+1
6354 nn=ncont_sent(iproc)
6355 zapas(1,nn,iproc)=ii
6356 zapas(2,nn,iproc)=jjc
6357 zapas(3,nn,iproc)=facont_hb(j,ii)
6358 zapas(4,nn,iproc)=ees0p(j,ii)
6359 zapas(5,nn,iproc)=ees0m(j,ii)
6360 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6361 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6362 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6363 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6364 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6365 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6366 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6367 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6368 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6369 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6370 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6371 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6372 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6373 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6374 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6375 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6376 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6377 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6378 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6379 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6380 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6388 c------------------------------------------------------------------------------
6389 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6391 C This subroutine calculates multi-body contributions to hydrogen-bonding
6392 implicit real*8 (a-h,o-z)
6393 include 'DIMENSIONS'
6394 include 'COMMON.IOUNITS'
6397 parameter (max_cont=maxconts)
6398 parameter (max_dim=70)
6399 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6400 double precision zapas(max_dim,maxconts,max_fg_procs),
6401 & zapas_recv(max_dim,maxconts,max_fg_procs)
6402 common /przechowalnia/ zapas
6403 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6404 & status_array(MPI_STATUS_SIZE,maxconts*2)
6406 include 'COMMON.SETUP'
6407 include 'COMMON.FFIELD'
6408 include 'COMMON.DERIV'
6409 include 'COMMON.LOCAL'
6410 include 'COMMON.INTERACT'
6411 include 'COMMON.CONTACTS'
6412 include 'COMMON.CHAIN'
6413 include 'COMMON.CONTROL'
6414 double precision gx(3),gx1(3)
6415 integer num_cont_hb_old(maxres)
6417 double precision eello4,eello5,eelo6,eello_turn6
6418 external eello4,eello5,eello6,eello_turn6
6419 C Set lprn=.true. for debugging
6424 num_cont_hb_old(i)=num_cont_hb(i)
6428 if (nfgtasks.le.1) goto 30
6430 write (iout,'(a)') 'Contact function values before RECEIVE:'
6432 write (iout,'(2i3,50(1x,i2,f5.2))')
6433 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6434 & j=1,num_cont_hb(i))
6438 do i=1,ntask_cont_from
6441 do i=1,ntask_cont_to
6444 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6446 C Make the list of contacts to send to send to other procesors
6447 do i=iturn3_start,iturn3_end
6448 c write (iout,*) "make contact list turn3",i," num_cont",
6450 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6452 do i=iturn4_start,iturn4_end
6453 c write (iout,*) "make contact list turn4",i," num_cont",
6455 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6459 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6461 do j=1,num_cont_hb(i)
6464 iproc=iint_sent_local(k,jjc,ii)
6465 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6466 if (iproc.ne.0) then
6467 ncont_sent(iproc)=ncont_sent(iproc)+1
6468 nn=ncont_sent(iproc)
6470 zapas(2,nn,iproc)=jjc
6471 zapas(3,nn,iproc)=d_cont(j,i)
6475 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6480 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6488 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6499 & "Numbers of contacts to be sent to other processors",
6500 & (ncont_sent(i),i=1,ntask_cont_to)
6501 write (iout,*) "Contacts sent"
6502 do ii=1,ntask_cont_to
6504 iproc=itask_cont_to(ii)
6505 write (iout,*) nn," contacts to processor",iproc,
6506 & " of CONT_TO_COMM group"
6508 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6516 CorrelID1=nfgtasks+fg_rank+1
6518 C Receive the numbers of needed contacts from other processors
6519 do ii=1,ntask_cont_from
6520 iproc=itask_cont_from(ii)
6522 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6523 & FG_COMM,req(ireq),IERR)
6525 c write (iout,*) "IRECV ended"
6527 C Send the number of contacts needed by other processors
6528 do ii=1,ntask_cont_to
6529 iproc=itask_cont_to(ii)
6531 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6532 & FG_COMM,req(ireq),IERR)
6534 c write (iout,*) "ISEND ended"
6535 c write (iout,*) "number of requests (nn)",ireq
6538 & call MPI_Waitall(ireq,req,status_array,ierr)
6540 c & "Numbers of contacts to be received from other processors",
6541 c & (ncont_recv(i),i=1,ntask_cont_from)
6545 do ii=1,ntask_cont_from
6546 iproc=itask_cont_from(ii)
6548 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6549 c & " of CONT_TO_COMM group"
6553 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6554 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6555 c write (iout,*) "ireq,req",ireq,req(ireq)
6558 C Send the contacts to processors that need them
6559 do ii=1,ntask_cont_to
6560 iproc=itask_cont_to(ii)
6562 c write (iout,*) nn," contacts to processor",iproc,
6563 c & " of CONT_TO_COMM group"
6566 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6567 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6568 c write (iout,*) "ireq,req",ireq,req(ireq)
6570 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6574 c write (iout,*) "number of requests (contacts)",ireq
6575 c write (iout,*) "req",(req(i),i=1,4)
6578 & call MPI_Waitall(ireq,req,status_array,ierr)
6579 do iii=1,ntask_cont_from
6580 iproc=itask_cont_from(iii)
6583 write (iout,*) "Received",nn," contacts from processor",iproc,
6584 & " of CONT_FROM_COMM group"
6587 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6592 ii=zapas_recv(1,i,iii)
6593 c Flag the received contacts to prevent double-counting
6594 jj=-zapas_recv(2,i,iii)
6595 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6597 nnn=num_cont_hb(ii)+1
6600 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6604 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6609 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6617 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6626 write (iout,'(a)') 'Contact function values after receive:'
6628 write (iout,'(2i3,50(1x,i3,5f6.3))')
6629 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6630 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6637 write (iout,'(a)') 'Contact function values:'
6639 write (iout,'(2i3,50(1x,i2,5f6.3))')
6640 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6641 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6647 C Remove the loop below after debugging !!!
6654 C Calculate the dipole-dipole interaction energies
6655 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6656 do i=iatel_s,iatel_e+1
6657 num_conti=num_cont_hb(i)
6666 C Calculate the local-electrostatic correlation terms
6667 c write (iout,*) "gradcorr5 in eello5 before loop"
6669 c write (iout,'(i5,3f10.5)')
6670 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6672 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6673 c write (iout,*) "corr loop i",i
6675 num_conti=num_cont_hb(i)
6676 num_conti1=num_cont_hb(i+1)
6683 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6684 c & ' jj=',jj,' kk=',kk
6685 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6686 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6687 & .or. j.lt.0 .and. j1.gt.0) .and.
6688 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6689 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6690 C The system gains extra energy.
6692 sqd1=dsqrt(d_cont(jj,i))
6693 sqd2=dsqrt(d_cont(kk,i1))
6694 sred_geom = sqd1*sqd2
6695 IF (sred_geom.lt.cutoff_corr) THEN
6696 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6698 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6699 cd & ' jj=',jj,' kk=',kk
6700 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6701 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6703 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6704 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6707 cd write (iout,*) 'sred_geom=',sred_geom,
6708 cd & ' ekont=',ekont,' fprim=',fprimcont,
6709 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6710 cd write (iout,*) "g_contij",g_contij
6711 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6712 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6713 call calc_eello(i,jp,i+1,jp1,jj,kk)
6714 if (wcorr4.gt.0.0d0)
6715 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6716 if (energy_dec.and.wcorr4.gt.0.0d0)
6717 1 write (iout,'(a6,4i5,0pf7.3)')
6718 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6719 c write (iout,*) "gradcorr5 before eello5"
6721 c write (iout,'(i5,3f10.5)')
6722 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6724 if (wcorr5.gt.0.0d0)
6725 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6726 c write (iout,*) "gradcorr5 after eello5"
6728 c write (iout,'(i5,3f10.5)')
6729 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6731 if (energy_dec.and.wcorr5.gt.0.0d0)
6732 1 write (iout,'(a6,4i5,0pf7.3)')
6733 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6734 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6735 cd write(2,*)'ijkl',i,jp,i+1,jp1
6736 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6737 & .or. wturn6.eq.0.0d0))then
6738 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6739 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6740 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6741 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6742 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6743 cd & 'ecorr6=',ecorr6
6744 cd write (iout,'(4e15.5)') sred_geom,
6745 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6746 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6747 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6748 else if (wturn6.gt.0.0d0
6749 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6750 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6751 eturn6=eturn6+eello_turn6(i,jj,kk)
6752 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6753 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6754 cd write (2,*) 'multibody_eello:eturn6',eturn6
6763 num_cont_hb(i)=num_cont_hb_old(i)
6765 c write (iout,*) "gradcorr5 in eello5"
6767 c write (iout,'(i5,3f10.5)')
6768 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6772 c------------------------------------------------------------------------------
6773 subroutine add_hb_contact_eello(ii,jj,itask)
6774 implicit real*8 (a-h,o-z)
6775 include "DIMENSIONS"
6776 include "COMMON.IOUNITS"
6779 parameter (max_cont=maxconts)
6780 parameter (max_dim=70)
6781 include "COMMON.CONTACTS"
6782 double precision zapas(max_dim,maxconts,max_fg_procs),
6783 & zapas_recv(max_dim,maxconts,max_fg_procs)
6784 common /przechowalnia/ zapas
6785 integer i,j,ii,jj,iproc,itask(4),nn
6786 c write (iout,*) "itask",itask
6789 if (iproc.gt.0) then
6790 do j=1,num_cont_hb(ii)
6792 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6794 ncont_sent(iproc)=ncont_sent(iproc)+1
6795 nn=ncont_sent(iproc)
6796 zapas(1,nn,iproc)=ii
6797 zapas(2,nn,iproc)=jjc
6798 zapas(3,nn,iproc)=d_cont(j,ii)
6802 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6807 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6815 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6827 c------------------------------------------------------------------------------
6828 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6829 implicit real*8 (a-h,o-z)
6830 include 'DIMENSIONS'
6831 include 'COMMON.IOUNITS'
6832 include 'COMMON.DERIV'
6833 include 'COMMON.INTERACT'
6834 include 'COMMON.CONTACTS'
6835 double precision gx(3),gx1(3)
6845 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6846 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6847 C Following 4 lines for diagnostics.
6852 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6853 c & 'Contacts ',i,j,
6854 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6855 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6857 C Calculate the multi-body contribution to energy.
6858 c ecorr=ecorr+ekont*ees
6859 C Calculate multi-body contributions to the gradient.
6860 coeffpees0pij=coeffp*ees0pij
6861 coeffmees0mij=coeffm*ees0mij
6862 coeffpees0pkl=coeffp*ees0pkl
6863 coeffmees0mkl=coeffm*ees0mkl
6865 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6866 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6867 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6868 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6869 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6870 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6871 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6872 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6873 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6874 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6875 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6876 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6877 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6878 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6879 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6880 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6881 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6882 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6883 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6884 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6885 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6886 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6887 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6888 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6889 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6894 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6895 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6896 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6897 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6902 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6903 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6904 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6905 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6908 c write (iout,*) "ehbcorr",ekont*ees
6913 C---------------------------------------------------------------------------
6914 subroutine dipole(i,j,jj)
6915 implicit real*8 (a-h,o-z)
6916 include 'DIMENSIONS'
6917 include 'COMMON.IOUNITS'
6918 include 'COMMON.CHAIN'
6919 include 'COMMON.FFIELD'
6920 include 'COMMON.DERIV'
6921 include 'COMMON.INTERACT'
6922 include 'COMMON.CONTACTS'
6923 include 'COMMON.TORSION'
6924 include 'COMMON.VAR'
6925 include 'COMMON.GEO'
6926 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6928 iti1 = itortyp(itype(i+1))
6929 if (j.lt.nres-1) then
6930 itj1 = itortyp(itype(j+1))
6935 dipi(iii,1)=Ub2(iii,i)
6936 dipderi(iii)=Ub2der(iii,i)
6937 dipi(iii,2)=b1(iii,iti1)
6938 dipj(iii,1)=Ub2(iii,j)
6939 dipderj(iii)=Ub2der(iii,j)
6940 dipj(iii,2)=b1(iii,itj1)
6944 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6947 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6954 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6958 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6963 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6964 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6966 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6968 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6970 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6975 C---------------------------------------------------------------------------
6976 subroutine calc_eello(i,j,k,l,jj,kk)
6978 C This subroutine computes matrices and vectors needed to calculate
6979 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6981 implicit real*8 (a-h,o-z)
6982 include 'DIMENSIONS'
6983 include 'COMMON.IOUNITS'
6984 include 'COMMON.CHAIN'
6985 include 'COMMON.DERIV'
6986 include 'COMMON.INTERACT'
6987 include 'COMMON.CONTACTS'
6988 include 'COMMON.TORSION'
6989 include 'COMMON.VAR'
6990 include 'COMMON.GEO'
6991 include 'COMMON.FFIELD'
6992 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6993 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6996 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6997 cd & ' jj=',jj,' kk=',kk
6998 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6999 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7000 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7003 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7004 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7007 call transpose2(aa1(1,1),aa1t(1,1))
7008 call transpose2(aa2(1,1),aa2t(1,1))
7011 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7012 & aa1tder(1,1,lll,kkk))
7013 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7014 & aa2tder(1,1,lll,kkk))
7018 C parallel orientation of the two CA-CA-CA frames.
7020 iti=itortyp(itype(i))
7024 itk1=itortyp(itype(k+1))
7025 itj=itortyp(itype(j))
7026 if (l.lt.nres-1) then
7027 itl1=itortyp(itype(l+1))
7031 C A1 kernel(j+1) A2T
7033 cd write (iout,'(3f10.5,5x,3f10.5)')
7034 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7036 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7037 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7038 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7039 C Following matrices are needed only for 6-th order cumulants
7040 IF (wcorr6.gt.0.0d0) THEN
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.,EUgC(1,1,l),EUgCder(1,1,l),
7043 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7044 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7045 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7046 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7047 & ADtEAderx(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.,DtUg2EUg(1,1,l),
7051 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7052 & ADtEA1derx(1,1,1,1,1,1))
7054 C End 6-th order cumulants
7057 cd write (2,*) 'In calc_eello6'
7059 cd write (2,*) 'iii=',iii
7061 cd write (2,*) 'kkk=',kkk
7063 cd write (2,'(3(2f10.5),5x)')
7064 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7069 call transpose2(EUgder(1,1,k),auxmat(1,1))
7070 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7071 call transpose2(EUg(1,1,k),auxmat(1,1))
7072 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7073 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7077 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7078 & EAEAderx(1,1,lll,kkk,iii,1))
7082 C A1T kernel(i+1) A2
7083 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7084 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7085 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7086 C Following matrices are needed only for 6-th order cumulants
7087 IF (wcorr6.gt.0.0d0) THEN
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.,EUgC(1,1,k),EUgCder(1,1,k),
7090 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7091 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7092 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7093 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7094 & ADtEAderx(1,1,1,1,1,2))
7095 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7096 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7097 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7098 & ADtEA1derx(1,1,1,1,1,2))
7100 C End 6-th order cumulants
7101 call transpose2(EUgder(1,1,l),auxmat(1,1))
7102 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7103 call transpose2(EUg(1,1,l),auxmat(1,1))
7104 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7105 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7109 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7110 & EAEAderx(1,1,lll,kkk,iii,2))
7115 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7116 C They are needed only when the fifth- or the sixth-order cumulants are
7118 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7119 call transpose2(AEA(1,1,1),auxmat(1,1))
7120 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7121 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7122 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7123 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7124 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7125 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7126 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7127 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7128 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7129 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7130 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7131 call transpose2(AEA(1,1,2),auxmat(1,1))
7132 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7133 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7134 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7135 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7136 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7137 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7138 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7139 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7140 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7141 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7142 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7143 C Calculate the Cartesian derivatives of the vectors.
7147 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7148 call matvec2(auxmat(1,1),b1(1,iti),
7149 & AEAb1derx(1,lll,kkk,iii,1,1))
7150 call matvec2(auxmat(1,1),Ub2(1,i),
7151 & AEAb2derx(1,lll,kkk,iii,1,1))
7152 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7153 & AEAb1derx(1,lll,kkk,iii,2,1))
7154 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7155 & AEAb2derx(1,lll,kkk,iii,2,1))
7156 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7157 call matvec2(auxmat(1,1),b1(1,itj),
7158 & AEAb1derx(1,lll,kkk,iii,1,2))
7159 call matvec2(auxmat(1,1),Ub2(1,j),
7160 & AEAb2derx(1,lll,kkk,iii,1,2))
7161 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7162 & AEAb1derx(1,lll,kkk,iii,2,2))
7163 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7164 & AEAb2derx(1,lll,kkk,iii,2,2))
7171 C Antiparallel orientation of the two CA-CA-CA frames.
7173 iti=itortyp(itype(i))
7177 itk1=itortyp(itype(k+1))
7178 itl=itortyp(itype(l))
7179 itj=itortyp(itype(j))
7180 if (j.lt.nres-1) then
7181 itj1=itortyp(itype(j+1))
7185 C A2 kernel(j-1)T A1T
7186 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7187 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7188 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7189 C Following matrices are needed only for 6-th order cumulants
7190 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7191 & j.eq.i+4 .and. l.eq.i+3)) THEN
7192 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7193 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7194 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7195 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7196 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7197 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7198 & ADtEAderx(1,1,1,1,1,1))
7199 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7200 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7201 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7202 & ADtEA1derx(1,1,1,1,1,1))
7204 C End 6-th order cumulants
7205 call transpose2(EUgder(1,1,k),auxmat(1,1))
7206 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7207 call transpose2(EUg(1,1,k),auxmat(1,1))
7208 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7209 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7213 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7214 & EAEAderx(1,1,lll,kkk,iii,1))
7218 C A2T kernel(i+1)T A1
7219 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7220 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7221 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7222 C Following matrices are needed only for 6-th order cumulants
7223 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7224 & j.eq.i+4 .and. l.eq.i+3)) THEN
7225 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7226 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7227 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7228 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7229 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7230 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7231 & ADtEAderx(1,1,1,1,1,2))
7232 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7233 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7234 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7235 & ADtEA1derx(1,1,1,1,1,2))
7237 C End 6-th order cumulants
7238 call transpose2(EUgder(1,1,j),auxmat(1,1))
7239 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7240 call transpose2(EUg(1,1,j),auxmat(1,1))
7241 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7242 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7246 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7247 & EAEAderx(1,1,lll,kkk,iii,2))
7252 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7253 C They are needed only when the fifth- or the sixth-order cumulants are
7255 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7256 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7257 call transpose2(AEA(1,1,1),auxmat(1,1))
7258 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7259 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7260 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7261 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7262 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7263 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7264 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7265 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7266 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7267 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7268 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7269 call transpose2(AEA(1,1,2),auxmat(1,1))
7270 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7271 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7272 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7273 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7274 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7275 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7276 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7277 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7278 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7279 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7280 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7281 C Calculate the Cartesian derivatives of the vectors.
7285 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7286 call matvec2(auxmat(1,1),b1(1,iti),
7287 & AEAb1derx(1,lll,kkk,iii,1,1))
7288 call matvec2(auxmat(1,1),Ub2(1,i),
7289 & AEAb2derx(1,lll,kkk,iii,1,1))
7290 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7291 & AEAb1derx(1,lll,kkk,iii,2,1))
7292 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7293 & AEAb2derx(1,lll,kkk,iii,2,1))
7294 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7295 call matvec2(auxmat(1,1),b1(1,itl),
7296 & AEAb1derx(1,lll,kkk,iii,1,2))
7297 call matvec2(auxmat(1,1),Ub2(1,l),
7298 & AEAb2derx(1,lll,kkk,iii,1,2))
7299 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7300 & AEAb1derx(1,lll,kkk,iii,2,2))
7301 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7302 & AEAb2derx(1,lll,kkk,iii,2,2))
7311 C---------------------------------------------------------------------------
7312 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7313 & KK,KKderg,AKA,AKAderg,AKAderx)
7317 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7318 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7319 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7324 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7326 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7329 cd if (lprn) write (2,*) 'In kernel'
7331 cd if (lprn) write (2,*) 'kkk=',kkk
7333 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7334 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7336 cd write (2,*) 'lll=',lll
7337 cd write (2,*) 'iii=1'
7339 cd write (2,'(3(2f10.5),5x)')
7340 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7343 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7344 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7346 cd write (2,*) 'lll=',lll
7347 cd write (2,*) 'iii=2'
7349 cd write (2,'(3(2f10.5),5x)')
7350 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7357 C---------------------------------------------------------------------------
7358 double precision function eello4(i,j,k,l,jj,kk)
7359 implicit real*8 (a-h,o-z)
7360 include 'DIMENSIONS'
7361 include 'COMMON.IOUNITS'
7362 include 'COMMON.CHAIN'
7363 include 'COMMON.DERIV'
7364 include 'COMMON.INTERACT'
7365 include 'COMMON.CONTACTS'
7366 include 'COMMON.TORSION'
7367 include 'COMMON.VAR'
7368 include 'COMMON.GEO'
7369 double precision pizda(2,2),ggg1(3),ggg2(3)
7370 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7374 cd print *,'eello4:',i,j,k,l,jj,kk
7375 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7376 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7377 cold eij=facont_hb(jj,i)
7378 cold ekl=facont_hb(kk,k)
7380 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7381 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7382 gcorr_loc(k-1)=gcorr_loc(k-1)
7383 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7385 gcorr_loc(l-1)=gcorr_loc(l-1)
7386 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7388 gcorr_loc(j-1)=gcorr_loc(j-1)
7389 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7394 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7395 & -EAEAderx(2,2,lll,kkk,iii,1)
7396 cd derx(lll,kkk,iii)=0.0d0
7400 cd gcorr_loc(l-1)=0.0d0
7401 cd gcorr_loc(j-1)=0.0d0
7402 cd gcorr_loc(k-1)=0.0d0
7404 cd write (iout,*)'Contacts have occurred for peptide groups',
7405 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7406 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7407 if (j.lt.nres-1) then
7414 if (l.lt.nres-1) then
7422 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7423 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7424 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7425 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7426 cgrad ghalf=0.5d0*ggg1(ll)
7427 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7428 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7429 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7430 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7431 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7432 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7433 cgrad ghalf=0.5d0*ggg2(ll)
7434 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7435 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7436 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7437 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7438 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7439 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7443 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7448 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7453 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7458 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7462 cd write (2,*) iii,gcorr_loc(iii)
7465 cd write (2,*) 'ekont',ekont
7466 cd write (iout,*) 'eello4',ekont*eel4
7469 C---------------------------------------------------------------------------
7470 double precision function eello5(i,j,k,l,jj,kk)
7471 implicit real*8 (a-h,o-z)
7472 include 'DIMENSIONS'
7473 include 'COMMON.IOUNITS'
7474 include 'COMMON.CHAIN'
7475 include 'COMMON.DERIV'
7476 include 'COMMON.INTERACT'
7477 include 'COMMON.CONTACTS'
7478 include 'COMMON.TORSION'
7479 include 'COMMON.VAR'
7480 include 'COMMON.GEO'
7481 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7482 double precision ggg1(3),ggg2(3)
7483 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7488 C /l\ / \ \ / \ / \ / C
7489 C / \ / \ \ / \ / \ / C
7490 C j| o |l1 | o | o| o | | o |o C
7491 C \ |/k\| |/ \| / |/ \| |/ \| C
7492 C \i/ \ / \ / / \ / \ C
7494 C (I) (II) (III) (IV) C
7496 C eello5_1 eello5_2 eello5_3 eello5_4 C
7498 C Antiparallel chains C
7501 C /j\ / \ \ / \ / \ / C
7502 C / \ / \ \ / \ / \ / C
7503 C j1| o |l | o | o| o | | o |o C
7504 C \ |/k\| |/ \| / |/ \| |/ \| C
7505 C \i/ \ / \ / / \ / \ C
7507 C (I) (II) (III) (IV) C
7509 C eello5_1 eello5_2 eello5_3 eello5_4 C
7511 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7513 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7514 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7519 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7521 itk=itortyp(itype(k))
7522 itl=itortyp(itype(l))
7523 itj=itortyp(itype(j))
7528 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7529 cd & eel5_3_num,eel5_4_num)
7533 derx(lll,kkk,iii)=0.0d0
7537 cd eij=facont_hb(jj,i)
7538 cd ekl=facont_hb(kk,k)
7540 cd write (iout,*)'Contacts have occurred for peptide groups',
7541 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7543 C Contribution from the graph I.
7544 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7545 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7546 call transpose2(EUg(1,1,k),auxmat(1,1))
7547 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7548 vv(1)=pizda(1,1)-pizda(2,2)
7549 vv(2)=pizda(1,2)+pizda(2,1)
7550 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7551 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7552 C Explicit gradient in virtual-dihedral angles.
7553 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7554 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7555 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7556 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7557 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7558 vv(1)=pizda(1,1)-pizda(2,2)
7559 vv(2)=pizda(1,2)+pizda(2,1)
7560 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7561 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7562 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7563 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7564 vv(1)=pizda(1,1)-pizda(2,2)
7565 vv(2)=pizda(1,2)+pizda(2,1)
7567 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7568 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7569 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7571 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7572 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7573 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7575 C Cartesian gradient
7579 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7581 vv(1)=pizda(1,1)-pizda(2,2)
7582 vv(2)=pizda(1,2)+pizda(2,1)
7583 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7584 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7585 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7591 C Contribution from graph II
7592 call transpose2(EE(1,1,itk),auxmat(1,1))
7593 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7594 vv(1)=pizda(1,1)+pizda(2,2)
7595 vv(2)=pizda(2,1)-pizda(1,2)
7596 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7597 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7598 C Explicit gradient in virtual-dihedral angles.
7599 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7600 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7601 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7602 vv(1)=pizda(1,1)+pizda(2,2)
7603 vv(2)=pizda(2,1)-pizda(1,2)
7605 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7606 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7607 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7609 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7610 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7611 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7613 C Cartesian gradient
7617 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7619 vv(1)=pizda(1,1)+pizda(2,2)
7620 vv(2)=pizda(2,1)-pizda(1,2)
7621 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7622 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7623 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7631 C Parallel orientation
7632 C Contribution from graph III
7633 call transpose2(EUg(1,1,l),auxmat(1,1))
7634 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7635 vv(1)=pizda(1,1)-pizda(2,2)
7636 vv(2)=pizda(1,2)+pizda(2,1)
7637 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7638 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7639 C Explicit gradient in virtual-dihedral angles.
7640 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7641 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7642 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7643 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7644 vv(1)=pizda(1,1)-pizda(2,2)
7645 vv(2)=pizda(1,2)+pizda(2,1)
7646 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7647 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7648 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7649 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7650 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7651 vv(1)=pizda(1,1)-pizda(2,2)
7652 vv(2)=pizda(1,2)+pizda(2,1)
7653 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7654 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7655 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7656 C Cartesian gradient
7660 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7662 vv(1)=pizda(1,1)-pizda(2,2)
7663 vv(2)=pizda(1,2)+pizda(2,1)
7664 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7665 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7666 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7671 C Contribution from graph IV
7673 call transpose2(EE(1,1,itl),auxmat(1,1))
7674 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7675 vv(1)=pizda(1,1)+pizda(2,2)
7676 vv(2)=pizda(2,1)-pizda(1,2)
7677 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7678 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7679 C Explicit gradient in virtual-dihedral angles.
7680 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7681 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7682 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7683 vv(1)=pizda(1,1)+pizda(2,2)
7684 vv(2)=pizda(2,1)-pizda(1,2)
7685 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7686 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7687 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7688 C Cartesian gradient
7692 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7694 vv(1)=pizda(1,1)+pizda(2,2)
7695 vv(2)=pizda(2,1)-pizda(1,2)
7696 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7697 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7698 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7703 C Antiparallel orientation
7704 C Contribution from graph III
7706 call transpose2(EUg(1,1,j),auxmat(1,1))
7707 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7708 vv(1)=pizda(1,1)-pizda(2,2)
7709 vv(2)=pizda(1,2)+pizda(2,1)
7710 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7711 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7712 C Explicit gradient in virtual-dihedral angles.
7713 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7714 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7715 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7716 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7717 vv(1)=pizda(1,1)-pizda(2,2)
7718 vv(2)=pizda(1,2)+pizda(2,1)
7719 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7720 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7721 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7722 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7723 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7724 vv(1)=pizda(1,1)-pizda(2,2)
7725 vv(2)=pizda(1,2)+pizda(2,1)
7726 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7727 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7728 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7729 C Cartesian gradient
7733 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7735 vv(1)=pizda(1,1)-pizda(2,2)
7736 vv(2)=pizda(1,2)+pizda(2,1)
7737 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7738 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7739 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7744 C Contribution from graph IV
7746 call transpose2(EE(1,1,itj),auxmat(1,1))
7747 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7748 vv(1)=pizda(1,1)+pizda(2,2)
7749 vv(2)=pizda(2,1)-pizda(1,2)
7750 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7751 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7752 C Explicit gradient in virtual-dihedral angles.
7753 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7754 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7755 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7756 vv(1)=pizda(1,1)+pizda(2,2)
7757 vv(2)=pizda(2,1)-pizda(1,2)
7758 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7759 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7760 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7761 C Cartesian gradient
7765 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7767 vv(1)=pizda(1,1)+pizda(2,2)
7768 vv(2)=pizda(2,1)-pizda(1,2)
7769 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7770 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7771 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7777 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7778 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7779 cd write (2,*) 'ijkl',i,j,k,l
7780 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7781 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7783 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7784 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7785 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7786 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7787 if (j.lt.nres-1) then
7794 if (l.lt.nres-1) then
7804 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7805 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7806 C summed up outside the subrouine as for the other subroutines
7807 C handling long-range interactions. The old code is commented out
7808 C with "cgrad" to keep track of changes.
7810 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7811 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7812 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7813 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7814 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7815 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7816 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7817 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7818 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7819 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7821 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7822 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7823 cgrad ghalf=0.5d0*ggg1(ll)
7825 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7826 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7827 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7828 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7829 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7830 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7831 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7832 cgrad ghalf=0.5d0*ggg2(ll)
7834 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
7835 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7836 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
7837 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7838 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7839 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7844 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7845 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7850 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7851 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7857 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7862 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7866 cd write (2,*) iii,g_corr5_loc(iii)
7869 cd write (2,*) 'ekont',ekont
7870 cd write (iout,*) 'eello5',ekont*eel5
7873 c--------------------------------------------------------------------------
7874 double precision function eello6(i,j,k,l,jj,kk)
7875 implicit real*8 (a-h,o-z)
7876 include 'DIMENSIONS'
7877 include 'COMMON.IOUNITS'
7878 include 'COMMON.CHAIN'
7879 include 'COMMON.DERIV'
7880 include 'COMMON.INTERACT'
7881 include 'COMMON.CONTACTS'
7882 include 'COMMON.TORSION'
7883 include 'COMMON.VAR'
7884 include 'COMMON.GEO'
7885 include 'COMMON.FFIELD'
7886 double precision ggg1(3),ggg2(3)
7887 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7892 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7900 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7901 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7905 derx(lll,kkk,iii)=0.0d0
7909 cd eij=facont_hb(jj,i)
7910 cd ekl=facont_hb(kk,k)
7916 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7917 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7918 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7919 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7920 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7921 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7923 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7924 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7925 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7926 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7927 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7928 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7932 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7934 C If turn contributions are considered, they will be handled separately.
7935 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7936 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7937 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7938 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7939 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7940 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7941 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7943 if (j.lt.nres-1) then
7950 if (l.lt.nres-1) then
7958 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7959 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7960 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7961 cgrad ghalf=0.5d0*ggg1(ll)
7963 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7964 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7965 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7966 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7967 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7968 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7969 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7970 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7971 cgrad ghalf=0.5d0*ggg2(ll)
7972 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7974 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7975 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7976 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7977 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7978 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7979 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7984 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7985 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7990 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7991 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7997 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8002 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8006 cd write (2,*) iii,g_corr6_loc(iii)
8009 cd write (2,*) 'ekont',ekont
8010 cd write (iout,*) 'eello6',ekont*eel6
8013 c--------------------------------------------------------------------------
8014 double precision function eello6_graph1(i,j,k,l,imat,swap)
8015 implicit real*8 (a-h,o-z)
8016 include 'DIMENSIONS'
8017 include 'COMMON.IOUNITS'
8018 include 'COMMON.CHAIN'
8019 include 'COMMON.DERIV'
8020 include 'COMMON.INTERACT'
8021 include 'COMMON.CONTACTS'
8022 include 'COMMON.TORSION'
8023 include 'COMMON.VAR'
8024 include 'COMMON.GEO'
8025 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8029 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8031 C Parallel Antiparallel C
8037 C \ j|/k\| / \ |/k\|l / C
8042 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8043 itk=itortyp(itype(k))
8044 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8045 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8046 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8047 call transpose2(EUgC(1,1,k),auxmat(1,1))
8048 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8049 vv1(1)=pizda1(1,1)-pizda1(2,2)
8050 vv1(2)=pizda1(1,2)+pizda1(2,1)
8051 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8052 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8053 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8054 s5=scalar2(vv(1),Dtobr2(1,i))
8055 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8056 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8057 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8058 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8059 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8060 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8061 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8062 & +scalar2(vv(1),Dtobr2der(1,i)))
8063 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8064 vv1(1)=pizda1(1,1)-pizda1(2,2)
8065 vv1(2)=pizda1(1,2)+pizda1(2,1)
8066 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8067 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8069 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8070 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8071 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8072 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8073 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8075 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8076 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8077 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8078 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8079 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8081 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8082 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8083 vv1(1)=pizda1(1,1)-pizda1(2,2)
8084 vv1(2)=pizda1(1,2)+pizda1(2,1)
8085 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8086 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8087 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8088 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8097 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8098 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8099 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8100 call transpose2(EUgC(1,1,k),auxmat(1,1))
8101 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8103 vv1(1)=pizda1(1,1)-pizda1(2,2)
8104 vv1(2)=pizda1(1,2)+pizda1(2,1)
8105 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8106 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8107 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8108 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8109 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8110 s5=scalar2(vv(1),Dtobr2(1,i))
8111 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8117 c----------------------------------------------------------------------------
8118 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8119 implicit real*8 (a-h,o-z)
8120 include 'DIMENSIONS'
8121 include 'COMMON.IOUNITS'
8122 include 'COMMON.CHAIN'
8123 include 'COMMON.DERIV'
8124 include 'COMMON.INTERACT'
8125 include 'COMMON.CONTACTS'
8126 include 'COMMON.TORSION'
8127 include 'COMMON.VAR'
8128 include 'COMMON.GEO'
8130 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8131 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8134 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8136 C Parallel Antiparallel C
8142 C \ j|/k\| \ |/k\|l C
8147 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8148 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8149 C AL 7/4/01 s1 would occur in the sixth-order moment,
8150 C but not in a cluster cumulant
8152 s1=dip(1,jj,i)*dip(1,kk,k)
8154 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8155 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8156 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8157 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8158 call transpose2(EUg(1,1,k),auxmat(1,1))
8159 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8160 vv(1)=pizda(1,1)-pizda(2,2)
8161 vv(2)=pizda(1,2)+pizda(2,1)
8162 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8163 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8165 eello6_graph2=-(s1+s2+s3+s4)
8167 eello6_graph2=-(s2+s3+s4)
8170 C Derivatives in gamma(i-1)
8173 s1=dipderg(1,jj,i)*dip(1,kk,k)
8175 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8176 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8177 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8178 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8180 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8182 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8184 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8186 C Derivatives in gamma(k-1)
8188 s1=dip(1,jj,i)*dipderg(1,kk,k)
8190 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8191 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8192 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8193 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8194 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8195 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8196 vv(1)=pizda(1,1)-pizda(2,2)
8197 vv(2)=pizda(1,2)+pizda(2,1)
8198 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8200 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8202 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8204 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8205 C Derivatives in gamma(j-1) or gamma(l-1)
8208 s1=dipderg(3,jj,i)*dip(1,kk,k)
8210 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8211 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8212 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8213 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8214 vv(1)=pizda(1,1)-pizda(2,2)
8215 vv(2)=pizda(1,2)+pizda(2,1)
8216 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8219 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8221 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8224 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8225 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8227 C Derivatives in gamma(l-1) or gamma(j-1)
8230 s1=dip(1,jj,i)*dipderg(3,kk,k)
8232 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8233 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8234 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8235 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8236 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8237 vv(1)=pizda(1,1)-pizda(2,2)
8238 vv(2)=pizda(1,2)+pizda(2,1)
8239 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8242 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8244 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8247 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8248 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8250 C Cartesian derivatives.
8252 write (2,*) 'In eello6_graph2'
8254 write (2,*) 'iii=',iii
8256 write (2,*) 'kkk=',kkk
8258 write (2,'(3(2f10.5),5x)')
8259 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8269 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8271 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8274 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8276 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8277 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8279 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8280 call transpose2(EUg(1,1,k),auxmat(1,1))
8281 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8283 vv(1)=pizda(1,1)-pizda(2,2)
8284 vv(2)=pizda(1,2)+pizda(2,1)
8285 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8286 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8288 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8290 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8293 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8295 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8302 c----------------------------------------------------------------------------
8303 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8304 implicit real*8 (a-h,o-z)
8305 include 'DIMENSIONS'
8306 include 'COMMON.IOUNITS'
8307 include 'COMMON.CHAIN'
8308 include 'COMMON.DERIV'
8309 include 'COMMON.INTERACT'
8310 include 'COMMON.CONTACTS'
8311 include 'COMMON.TORSION'
8312 include 'COMMON.VAR'
8313 include 'COMMON.GEO'
8314 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8316 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8318 C Parallel Antiparallel C
8324 C j|/k\| / |/k\|l / C
8329 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8331 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8332 C energy moment and not to the cluster cumulant.
8333 iti=itortyp(itype(i))
8334 if (j.lt.nres-1) then
8335 itj1=itortyp(itype(j+1))
8339 itk=itortyp(itype(k))
8340 itk1=itortyp(itype(k+1))
8341 if (l.lt.nres-1) then
8342 itl1=itortyp(itype(l+1))
8347 s1=dip(4,jj,i)*dip(4,kk,k)
8349 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8350 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8351 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8352 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8353 call transpose2(EE(1,1,itk),auxmat(1,1))
8354 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8355 vv(1)=pizda(1,1)+pizda(2,2)
8356 vv(2)=pizda(2,1)-pizda(1,2)
8357 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8358 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8359 cd & "sum",-(s2+s3+s4)
8361 eello6_graph3=-(s1+s2+s3+s4)
8363 eello6_graph3=-(s2+s3+s4)
8366 C Derivatives in gamma(k-1)
8367 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8368 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8369 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8370 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8371 C Derivatives in gamma(l-1)
8372 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8373 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8374 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8375 vv(1)=pizda(1,1)+pizda(2,2)
8376 vv(2)=pizda(2,1)-pizda(1,2)
8377 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8378 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8379 C Cartesian derivatives.
8385 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8387 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8390 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8392 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8393 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8395 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8396 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8398 vv(1)=pizda(1,1)+pizda(2,2)
8399 vv(2)=pizda(2,1)-pizda(1,2)
8400 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8402 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8404 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8407 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8409 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8411 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8417 c----------------------------------------------------------------------------
8418 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8419 implicit real*8 (a-h,o-z)
8420 include 'DIMENSIONS'
8421 include 'COMMON.IOUNITS'
8422 include 'COMMON.CHAIN'
8423 include 'COMMON.DERIV'
8424 include 'COMMON.INTERACT'
8425 include 'COMMON.CONTACTS'
8426 include 'COMMON.TORSION'
8427 include 'COMMON.VAR'
8428 include 'COMMON.GEO'
8429 include 'COMMON.FFIELD'
8430 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8431 & auxvec1(2),auxmat1(2,2)
8433 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8435 C Parallel Antiparallel C
8441 C \ j|/k\| \ |/k\|l C
8446 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8448 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8449 C energy moment and not to the cluster cumulant.
8450 cd write (2,*) 'eello_graph4: wturn6',wturn6
8451 iti=itortyp(itype(i))
8452 itj=itortyp(itype(j))
8453 if (j.lt.nres-1) then
8454 itj1=itortyp(itype(j+1))
8458 itk=itortyp(itype(k))
8459 if (k.lt.nres-1) then
8460 itk1=itortyp(itype(k+1))
8464 itl=itortyp(itype(l))
8465 if (l.lt.nres-1) then
8466 itl1=itortyp(itype(l+1))
8470 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8471 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8472 cd & ' itl',itl,' itl1',itl1
8475 s1=dip(3,jj,i)*dip(3,kk,k)
8477 s1=dip(2,jj,j)*dip(2,kk,l)
8480 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8481 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8483 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8484 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8486 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8487 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8489 call transpose2(EUg(1,1,k),auxmat(1,1))
8490 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8491 vv(1)=pizda(1,1)-pizda(2,2)
8492 vv(2)=pizda(2,1)+pizda(1,2)
8493 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8494 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8496 eello6_graph4=-(s1+s2+s3+s4)
8498 eello6_graph4=-(s2+s3+s4)
8500 C Derivatives in gamma(i-1)
8504 s1=dipderg(2,jj,i)*dip(3,kk,k)
8506 s1=dipderg(4,jj,j)*dip(2,kk,l)
8509 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8511 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8512 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8514 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8515 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8517 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8518 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8519 cd write (2,*) 'turn6 derivatives'
8521 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8523 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8527 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8529 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8533 C Derivatives in gamma(k-1)
8536 s1=dip(3,jj,i)*dipderg(2,kk,k)
8538 s1=dip(2,jj,j)*dipderg(4,kk,l)
8541 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8542 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8544 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8545 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8547 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8548 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8550 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8551 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8552 vv(1)=pizda(1,1)-pizda(2,2)
8553 vv(2)=pizda(2,1)+pizda(1,2)
8554 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8555 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8557 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8559 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8563 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8565 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8568 C Derivatives in gamma(j-1) or gamma(l-1)
8569 if (l.eq.j+1 .and. l.gt.1) then
8570 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8571 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8572 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8573 vv(1)=pizda(1,1)-pizda(2,2)
8574 vv(2)=pizda(2,1)+pizda(1,2)
8575 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8576 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8577 else if (j.gt.1) then
8578 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8579 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8580 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8581 vv(1)=pizda(1,1)-pizda(2,2)
8582 vv(2)=pizda(2,1)+pizda(1,2)
8583 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8584 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8585 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8587 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8590 C Cartesian derivatives.
8597 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8599 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8603 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8605 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8609 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8611 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8613 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8614 & b1(1,itj1),auxvec(1))
8615 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8617 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8618 & b1(1,itl1),auxvec(1))
8619 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8621 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8623 vv(1)=pizda(1,1)-pizda(2,2)
8624 vv(2)=pizda(2,1)+pizda(1,2)
8625 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8627 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8629 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8632 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8635 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8638 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8640 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8642 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8646 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8648 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8651 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8653 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8661 c----------------------------------------------------------------------------
8662 double precision function eello_turn6(i,jj,kk)
8663 implicit real*8 (a-h,o-z)
8664 include 'DIMENSIONS'
8665 include 'COMMON.IOUNITS'
8666 include 'COMMON.CHAIN'
8667 include 'COMMON.DERIV'
8668 include 'COMMON.INTERACT'
8669 include 'COMMON.CONTACTS'
8670 include 'COMMON.TORSION'
8671 include 'COMMON.VAR'
8672 include 'COMMON.GEO'
8673 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8674 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8676 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8677 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8678 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8679 C the respective energy moment and not to the cluster cumulant.
8688 iti=itortyp(itype(i))
8689 itk=itortyp(itype(k))
8690 itk1=itortyp(itype(k+1))
8691 itl=itortyp(itype(l))
8692 itj=itortyp(itype(j))
8693 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8694 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8695 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8700 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8702 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8706 derx_turn(lll,kkk,iii)=0.0d0
8713 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8715 cd write (2,*) 'eello6_5',eello6_5
8717 call transpose2(AEA(1,1,1),auxmat(1,1))
8718 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8719 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8720 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8722 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8723 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8724 s2 = scalar2(b1(1,itk),vtemp1(1))
8726 call transpose2(AEA(1,1,2),atemp(1,1))
8727 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8728 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8729 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8731 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8732 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8733 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8735 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8736 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8737 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8738 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8739 ss13 = scalar2(b1(1,itk),vtemp4(1))
8740 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8742 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8748 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8749 C Derivatives in gamma(i+2)
8753 call transpose2(AEA(1,1,1),auxmatd(1,1))
8754 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8755 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8756 call transpose2(AEAderg(1,1,2),atempd(1,1))
8757 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8758 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8760 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8761 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8762 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8768 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8769 C Derivatives in gamma(i+3)
8771 call transpose2(AEA(1,1,1),auxmatd(1,1))
8772 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8773 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8774 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8776 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8777 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8778 s2d = scalar2(b1(1,itk),vtemp1d(1))
8780 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8781 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8783 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8785 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8786 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8787 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8795 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8796 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8798 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8799 & -0.5d0*ekont*(s2d+s12d)
8801 C Derivatives in gamma(i+4)
8802 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8803 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8804 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8806 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8807 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8808 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8816 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8818 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8820 C Derivatives in gamma(i+5)
8822 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8823 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8824 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8826 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8827 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8828 s2d = scalar2(b1(1,itk),vtemp1d(1))
8830 call transpose2(AEA(1,1,2),atempd(1,1))
8831 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8832 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8834 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8835 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8837 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8838 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8839 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8847 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8848 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8850 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8851 & -0.5d0*ekont*(s2d+s12d)
8853 C Cartesian derivatives
8858 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8859 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8860 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8862 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8863 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8865 s2d = scalar2(b1(1,itk),vtemp1d(1))
8867 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8868 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8869 s8d = -(atempd(1,1)+atempd(2,2))*
8870 & scalar2(cc(1,1,itl),vtemp2(1))
8872 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8874 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8875 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8882 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8885 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8889 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8890 & - 0.5d0*(s8d+s12d)
8892 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8901 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8903 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8904 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8905 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8906 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8907 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8909 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8910 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8911 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8915 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8916 cd & 16*eel_turn6_num
8918 if (j.lt.nres-1) then
8925 if (l.lt.nres-1) then
8933 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8934 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8935 cgrad ghalf=0.5d0*ggg1(ll)
8937 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8938 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8939 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8940 & +ekont*derx_turn(ll,2,1)
8941 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8942 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8943 & +ekont*derx_turn(ll,4,1)
8944 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8945 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8946 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8947 cgrad ghalf=0.5d0*ggg2(ll)
8949 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8950 & +ekont*derx_turn(ll,2,2)
8951 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8952 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8953 & +ekont*derx_turn(ll,4,2)
8954 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8955 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8956 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8961 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8966 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8972 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8977 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8981 cd write (2,*) iii,g_corr6_loc(iii)
8983 eello_turn6=ekont*eel_turn6
8984 cd write (2,*) 'ekont',ekont
8985 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8989 C-----------------------------------------------------------------------------
8990 double precision function scalar(u,v)
8991 !DIR$ INLINEALWAYS scalar
8993 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8996 double precision u(3),v(3)
8997 cd double precision sc
9005 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9008 crc-------------------------------------------------
9009 SUBROUTINE MATVEC2(A1,V1,V2)
9010 !DIR$ INLINEALWAYS MATVEC2
9012 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9014 implicit real*8 (a-h,o-z)
9015 include 'DIMENSIONS'
9016 DIMENSION A1(2,2),V1(2),V2(2)
9020 c 3 VI=VI+A1(I,K)*V1(K)
9024 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9025 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9030 C---------------------------------------
9031 SUBROUTINE MATMAT2(A1,A2,A3)
9033 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9035 implicit real*8 (a-h,o-z)
9036 include 'DIMENSIONS'
9037 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9038 c DIMENSION AI3(2,2)
9042 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9048 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9049 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9050 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9051 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9059 c-------------------------------------------------------------------------
9060 double precision function scalar2(u,v)
9061 !DIR$ INLINEALWAYS scalar2
9063 double precision u(2),v(2)
9066 scalar2=u(1)*v(1)+u(2)*v(2)
9070 C-----------------------------------------------------------------------------
9072 subroutine transpose2(a,at)
9073 !DIR$ INLINEALWAYS transpose2
9075 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9078 double precision a(2,2),at(2,2)
9085 c--------------------------------------------------------------------------
9086 subroutine transpose(n,a,at)
9089 double precision a(n,n),at(n,n)
9097 C---------------------------------------------------------------------------
9098 subroutine prodmat3(a1,a2,kk,transp,prod)
9099 !DIR$ INLINEALWAYS prodmat3
9101 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9105 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9107 crc double precision auxmat(2,2),prod_(2,2)
9110 crc call transpose2(kk(1,1),auxmat(1,1))
9111 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9112 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9114 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9115 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9116 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9117 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9118 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9119 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9120 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9121 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9124 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9125 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9127 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9128 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9129 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9130 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9131 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9132 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9133 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9134 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9137 c call transpose2(a2(1,1),a2t(1,1))
9140 crc print *,((prod_(i,j),i=1,2),j=1,2)
9141 crc print *,((prod(i,j),i=1,2),j=1,2)