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'
4089 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4090 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4091 if (link_end.eq.0) return
4092 do i=link_start,link_end
4093 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4094 C CA-CA distance used in regularization of structure.
4097 C iii and jjj point to the residues for which the distance is assigned.
4098 if (ii.gt.nres) then
4105 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4106 c & dhpb(i),dhpb1(i),forcon(i)
4107 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4108 C distance and angle dependent SS bond potential.
4109 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4110 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4111 if (.not.dyn_ss .and. i.le.nss) then
4112 C 15/02/13 CC dynamic SSbond - additional check
4113 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4114 & iabs(itype(jjj)).eq.1) then
4115 call ssbond_ene(iii,jjj,eij)
4118 cd write (iout,*) "eij",eij
4120 C Calculate the distance between the two points and its difference from the
4124 C Get the force constant corresponding to this distance.
4126 C Calculate the contribution to energy.
4127 ehpb=ehpb+waga*rdis*rdis
4129 C Evaluate gradient.
4132 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4133 cd & ' waga=',waga,' fac=',fac
4135 ggg(j)=fac*(c(j,jj)-c(j,ii))
4137 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4138 C If this is a SC-SC distance, we need to calculate the contributions to the
4139 C Cartesian gradient in the SC vectors (ghpbx).
4142 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4143 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4146 cgrad do j=iii,jjj-1
4148 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4152 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4153 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4160 C--------------------------------------------------------------------------
4161 subroutine ssbond_ene(i,j,eij)
4163 C Calculate the distance and angle dependent SS-bond potential energy
4164 C using a free-energy function derived based on RHF/6-31G** ab initio
4165 C calculations of diethyl disulfide.
4167 C A. Liwo and U. Kozlowska, 11/24/03
4169 implicit real*8 (a-h,o-z)
4170 include 'DIMENSIONS'
4171 include 'COMMON.SBRIDGE'
4172 include 'COMMON.CHAIN'
4173 include 'COMMON.DERIV'
4174 include 'COMMON.LOCAL'
4175 include 'COMMON.INTERACT'
4176 include 'COMMON.VAR'
4177 include 'COMMON.IOUNITS'
4178 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4179 itypi=iabs(itype(i))
4183 dxi=dc_norm(1,nres+i)
4184 dyi=dc_norm(2,nres+i)
4185 dzi=dc_norm(3,nres+i)
4186 c dsci_inv=dsc_inv(itypi)
4187 dsci_inv=vbld_inv(nres+i)
4188 itypj=iabs(itype(j))
4189 c dscj_inv=dsc_inv(itypj)
4190 dscj_inv=vbld_inv(nres+j)
4194 dxj=dc_norm(1,nres+j)
4195 dyj=dc_norm(2,nres+j)
4196 dzj=dc_norm(3,nres+j)
4197 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4202 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4203 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4204 om12=dxi*dxj+dyi*dyj+dzi*dzj
4206 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4207 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4213 deltat12=om2-om1+2.0d0
4215 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4216 & +akct*deltad*deltat12
4217 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4218 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4219 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4220 c & " deltat12",deltat12," eij",eij
4221 ed=2*akcm*deltad+akct*deltat12
4223 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4224 eom1=-2*akth*deltat1-pom1-om2*pom2
4225 eom2= 2*akth*deltat2+pom1-om1*pom2
4228 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4229 ghpbx(k,i)=ghpbx(k,i)-ggk
4230 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4231 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4232 ghpbx(k,j)=ghpbx(k,j)+ggk
4233 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4234 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4235 ghpbc(k,i)=ghpbc(k,i)-ggk
4236 ghpbc(k,j)=ghpbc(k,j)+ggk
4239 C Calculate the components of the gradient in DC and X
4243 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4248 C--------------------------------------------------------------------------
4249 subroutine ebond(estr)
4251 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4253 implicit real*8 (a-h,o-z)
4254 include 'DIMENSIONS'
4255 include 'COMMON.LOCAL'
4256 include 'COMMON.GEO'
4257 include 'COMMON.INTERACT'
4258 include 'COMMON.DERIV'
4259 include 'COMMON.VAR'
4260 include 'COMMON.CHAIN'
4261 include 'COMMON.IOUNITS'
4262 include 'COMMON.NAMES'
4263 include 'COMMON.FFIELD'
4264 include 'COMMON.CONTROL'
4265 include 'COMMON.SETUP'
4266 double precision u(3),ud(3)
4269 do i=ibondp_start,ibondp_end
4270 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4271 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4273 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4274 & *dc(j,i-1)/vbld(i)
4276 if (energy_dec) write(iout,*)
4277 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4279 diff = vbld(i)-vbldp0
4280 if (energy_dec) write (iout,*)
4281 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4284 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4286 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4289 estr=0.5d0*AKP*estr+estr1
4291 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4293 do i=ibond_start,ibond_end
4295 if (iti.ne.10 .and. iti.ne.ntyp1) then
4298 diff=vbld(i+nres)-vbldsc0(1,iti)
4299 if (energy_dec) write (iout,*)
4300 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4301 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4302 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4304 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4308 diff=vbld(i+nres)-vbldsc0(j,iti)
4309 ud(j)=aksc(j,iti)*diff
4310 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4324 uprod2=uprod2*u(k)*u(k)
4328 usumsqder=usumsqder+ud(j)*uprod2
4330 estr=estr+uprod/usum
4332 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4340 C--------------------------------------------------------------------------
4341 subroutine ebend(etheta)
4343 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4344 C angles gamma and its derivatives in consecutive thetas and gammas.
4346 implicit real*8 (a-h,o-z)
4347 include 'DIMENSIONS'
4348 include 'COMMON.LOCAL'
4349 include 'COMMON.GEO'
4350 include 'COMMON.INTERACT'
4351 include 'COMMON.DERIV'
4352 include 'COMMON.VAR'
4353 include 'COMMON.CHAIN'
4354 include 'COMMON.IOUNITS'
4355 include 'COMMON.NAMES'
4356 include 'COMMON.FFIELD'
4357 include 'COMMON.CONTROL'
4358 common /calcthet/ term1,term2,termm,diffak,ratak,
4359 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4360 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4361 double precision y(2),z(2)
4363 c time11=dexp(-2*time)
4366 c write (*,'(a,i2)') 'EBEND ICG=',icg
4367 do i=ithet_start,ithet_end
4368 if (itype(i-1).eq.ntyp1) cycle
4369 C Zero the energy function and its derivative at 0 or pi.
4370 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4372 ichir1=isign(1,itype(i-2))
4373 ichir2=isign(1,itype(i))
4374 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4375 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4376 if (itype(i-1).eq.10) then
4377 itype1=isign(10,itype(i-2))
4378 ichir11=isign(1,itype(i-2))
4379 ichir12=isign(1,itype(i-2))
4380 itype2=isign(10,itype(i))
4381 ichir21=isign(1,itype(i))
4382 ichir22=isign(1,itype(i))
4385 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4388 if (phii.ne.phii) phii=150.0
4398 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4401 if (phii1.ne.phii1) phii1=150.0
4413 C Calculate the "mean" value of theta from the part of the distribution
4414 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4415 C In following comments this theta will be referred to as t_c.
4416 thet_pred_mean=0.0d0
4418 athetk=athet(k,it,ichir1,ichir2)
4419 bthetk=bthet(k,it,ichir1,ichir2)
4421 athetk=athet(k,itype1,ichir11,ichir12)
4422 bthetk=bthet(k,itype2,ichir21,ichir22)
4424 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4426 dthett=thet_pred_mean*ssd
4427 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4428 C Derivatives of the "mean" values in gamma1 and gamma2.
4429 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4430 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4431 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4432 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4434 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4435 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4436 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4437 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4439 if (theta(i).gt.pi-delta) then
4440 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4442 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4443 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4444 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4446 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4448 else if (theta(i).lt.delta) then
4449 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4450 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4451 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4453 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4454 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4457 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4460 etheta=etheta+ethetai
4461 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4463 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4464 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4465 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4467 C Ufff.... We've done all this!!!
4470 C---------------------------------------------------------------------------
4471 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4473 implicit real*8 (a-h,o-z)
4474 include 'DIMENSIONS'
4475 include 'COMMON.LOCAL'
4476 include 'COMMON.IOUNITS'
4477 common /calcthet/ term1,term2,termm,diffak,ratak,
4478 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4479 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4480 C Calculate the contributions to both Gaussian lobes.
4481 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4482 C The "polynomial part" of the "standard deviation" of this part of
4486 sig=sig*thet_pred_mean+polthet(j,it)
4488 C Derivative of the "interior part" of the "standard deviation of the"
4489 C gamma-dependent Gaussian lobe in t_c.
4490 sigtc=3*polthet(3,it)
4492 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4495 C Set the parameters of both Gaussian lobes of the distribution.
4496 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4497 fac=sig*sig+sigc0(it)
4500 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4501 sigsqtc=-4.0D0*sigcsq*sigtc
4502 c print *,i,sig,sigtc,sigsqtc
4503 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4504 sigtc=-sigtc/(fac*fac)
4505 C Following variable is sigma(t_c)**(-2)
4506 sigcsq=sigcsq*sigcsq
4508 sig0inv=1.0D0/sig0i**2
4509 delthec=thetai-thet_pred_mean
4510 delthe0=thetai-theta0i
4511 term1=-0.5D0*sigcsq*delthec*delthec
4512 term2=-0.5D0*sig0inv*delthe0*delthe0
4513 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4514 C NaNs in taking the logarithm. We extract the largest exponent which is added
4515 C to the energy (this being the log of the distribution) at the end of energy
4516 C term evaluation for this virtual-bond angle.
4517 if (term1.gt.term2) then
4519 term2=dexp(term2-termm)
4523 term1=dexp(term1-termm)
4526 C The ratio between the gamma-independent and gamma-dependent lobes of
4527 C the distribution is a Gaussian function of thet_pred_mean too.
4528 diffak=gthet(2,it)-thet_pred_mean
4529 ratak=diffak/gthet(3,it)**2
4530 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4531 C Let's differentiate it in thet_pred_mean NOW.
4533 C Now put together the distribution terms to make complete distribution.
4534 termexp=term1+ak*term2
4535 termpre=sigc+ak*sig0i
4536 C Contribution of the bending energy from this theta is just the -log of
4537 C the sum of the contributions from the two lobes and the pre-exponential
4538 C factor. Simple enough, isn't it?
4539 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4540 C NOW the derivatives!!!
4541 C 6/6/97 Take into account the deformation.
4542 E_theta=(delthec*sigcsq*term1
4543 & +ak*delthe0*sig0inv*term2)/termexp
4544 E_tc=((sigtc+aktc*sig0i)/termpre
4545 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4546 & aktc*term2)/termexp)
4549 c-----------------------------------------------------------------------------
4550 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4551 implicit real*8 (a-h,o-z)
4552 include 'DIMENSIONS'
4553 include 'COMMON.LOCAL'
4554 include 'COMMON.IOUNITS'
4555 common /calcthet/ term1,term2,termm,diffak,ratak,
4556 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4557 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4558 delthec=thetai-thet_pred_mean
4559 delthe0=thetai-theta0i
4560 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4561 t3 = thetai-thet_pred_mean
4565 t14 = t12+t6*sigsqtc
4567 t21 = thetai-theta0i
4573 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4574 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4575 & *(-t12*t9-ak*sig0inv*t27)
4579 C--------------------------------------------------------------------------
4580 subroutine ebend(etheta)
4582 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4583 C angles gamma and its derivatives in consecutive thetas and gammas.
4584 C ab initio-derived potentials from
4585 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4587 implicit real*8 (a-h,o-z)
4588 include 'DIMENSIONS'
4589 include 'COMMON.LOCAL'
4590 include 'COMMON.GEO'
4591 include 'COMMON.INTERACT'
4592 include 'COMMON.DERIV'
4593 include 'COMMON.VAR'
4594 include 'COMMON.CHAIN'
4595 include 'COMMON.IOUNITS'
4596 include 'COMMON.NAMES'
4597 include 'COMMON.FFIELD'
4598 include 'COMMON.CONTROL'
4599 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4600 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4601 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4602 & sinph1ph2(maxdouble,maxdouble)
4603 logical lprn /.false./, lprn1 /.false./
4605 do i=ithet_start,ithet_end
4606 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4607 &(itype(i).eq.ntyp1)) cycle
4608 C print *,i,theta(i)
4609 if (iabs(itype(i+1)).eq.20) iblock=2
4610 if (iabs(itype(i+1)).ne.20) iblock=1
4614 theti2=0.5d0*theta(i)
4615 ityp2=ithetyp((itype(i-1)))
4617 coskt(k)=dcos(k*theti2)
4618 sinkt(k)=dsin(k*theti2)
4622 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4625 if (phii.ne.phii) phii=150.0
4629 ityp1=ithetyp((itype(i-2)))
4630 C propagation of chirality for glycine type
4632 cosph1(k)=dcos(k*phii)
4633 sinph1(k)=dsin(k*phii)
4638 ityp1=ithetyp((itype(i-2)))
4643 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4646 if (phii1.ne.phii1) phii1=150.0
4651 ityp3=ithetyp((itype(i)))
4653 cosph2(k)=dcos(k*phii1)
4654 sinph2(k)=dsin(k*phii1)
4658 ityp3=ithetyp((itype(i)))
4664 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4667 ccl=cosph1(l)*cosph2(k-l)
4668 ssl=sinph1(l)*sinph2(k-l)
4669 scl=sinph1(l)*cosph2(k-l)
4670 csl=cosph1(l)*sinph2(k-l)
4671 cosph1ph2(l,k)=ccl-ssl
4672 cosph1ph2(k,l)=ccl+ssl
4673 sinph1ph2(l,k)=scl+csl
4674 sinph1ph2(k,l)=scl-csl
4678 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4679 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4680 write (iout,*) "coskt and sinkt"
4682 write (iout,*) k,coskt(k),sinkt(k)
4686 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4687 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4690 & write (iout,*) "k",k,"
4691 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4692 & " ethetai",ethetai
4695 write (iout,*) "cosph and sinph"
4697 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4699 write (iout,*) "cosph1ph2 and sinph2ph2"
4702 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4703 & sinph1ph2(l,k),sinph1ph2(k,l)
4706 write(iout,*) "ethetai",ethetai
4711 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4712 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4713 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4714 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4715 ethetai=ethetai+sinkt(m)*aux
4716 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4717 dephii=dephii+k*sinkt(m)*(
4718 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4719 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4720 dephii1=dephii1+k*sinkt(m)*(
4721 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4722 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4724 & write (iout,*) "m",m," k",k," bbthet",
4725 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4726 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4727 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4728 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4729 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4732 C print *,"cosph1", (cosph1(k), k=1,nsingle)
4733 C print *,"cosph2", (cosph2(k), k=1,nsingle)
4734 C print *,"sinph1", (sinph1(k), k=1,nsingle)
4735 C print *,"sinph2", (sinph2(k), k=1,nsingle)
4737 & write(iout,*) "ethetai",ethetai
4738 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4742 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4743 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4744 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4745 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4746 ethetai=ethetai+sinkt(m)*aux
4747 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4748 dephii=dephii+l*sinkt(m)*(
4749 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4750 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4751 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4752 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4753 dephii1=dephii1+(k-l)*sinkt(m)*(
4754 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4755 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4756 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4757 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4759 write (iout,*) "m",m," k",k," l",l," ffthet",
4760 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4761 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4762 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4763 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4764 & " ethetai",ethetai
4765 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4766 & cosph1ph2(k,l)*sinkt(m),
4767 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4776 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4777 & i,theta(i)*rad2deg,phii*rad2deg,
4778 & phii1*rad2deg,ethetai
4780 etheta=etheta+ethetai
4781 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4782 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4783 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4789 c-----------------------------------------------------------------------------
4790 subroutine esc(escloc)
4791 C Calculate the local energy of a side chain and its derivatives in the
4792 C corresponding virtual-bond valence angles THETA and the spherical angles
4794 implicit real*8 (a-h,o-z)
4795 include 'DIMENSIONS'
4796 include 'COMMON.GEO'
4797 include 'COMMON.LOCAL'
4798 include 'COMMON.VAR'
4799 include 'COMMON.INTERACT'
4800 include 'COMMON.DERIV'
4801 include 'COMMON.CHAIN'
4802 include 'COMMON.IOUNITS'
4803 include 'COMMON.NAMES'
4804 include 'COMMON.FFIELD'
4805 include 'COMMON.CONTROL'
4806 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4807 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4808 common /sccalc/ time11,time12,time112,theti,it,nlobit
4811 c write (iout,'(a)') 'ESC'
4812 do i=loc_start,loc_end
4814 if (it.eq.ntyp1) cycle
4815 if (it.eq.10) goto 1
4816 nlobit=nlob(iabs(it))
4817 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4818 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4819 theti=theta(i+1)-pipol
4824 if (x(2).gt.pi-delta) then
4828 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4830 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4831 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4833 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4834 & ddersc0(1),dersc(1))
4835 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4836 & ddersc0(3),dersc(3))
4838 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4840 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4841 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4842 & dersc0(2),esclocbi,dersc02)
4843 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4845 call splinthet(x(2),0.5d0*delta,ss,ssd)
4850 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4852 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4853 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4855 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4857 c write (iout,*) escloci
4858 else if (x(2).lt.delta) then
4862 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4864 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4865 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4867 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4868 & ddersc0(1),dersc(1))
4869 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4870 & ddersc0(3),dersc(3))
4872 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4874 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4875 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4876 & dersc0(2),esclocbi,dersc02)
4877 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4882 call splinthet(x(2),0.5d0*delta,ss,ssd)
4884 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4886 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4887 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4889 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4890 c write (iout,*) escloci
4892 call enesc(x,escloci,dersc,ddummy,.false.)
4895 escloc=escloc+escloci
4896 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4897 & 'escloc',i,escloci
4898 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4900 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4902 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4903 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4908 C---------------------------------------------------------------------------
4909 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4910 implicit real*8 (a-h,o-z)
4911 include 'DIMENSIONS'
4912 include 'COMMON.GEO'
4913 include 'COMMON.LOCAL'
4914 include 'COMMON.IOUNITS'
4915 common /sccalc/ time11,time12,time112,theti,it,nlobit
4916 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4917 double precision contr(maxlob,-1:1)
4919 c write (iout,*) 'it=',it,' nlobit=',nlobit
4923 if (mixed) ddersc(j)=0.0d0
4927 C Because of periodicity of the dependence of the SC energy in omega we have
4928 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4929 C To avoid underflows, first compute & store the exponents.
4937 z(k)=x(k)-censc(k,j,it)
4942 Axk=Axk+gaussc(l,k,j,it)*z(l)
4948 expfac=expfac+Ax(k,j,iii)*z(k)
4956 C As in the case of ebend, we want to avoid underflows in exponentiation and
4957 C subsequent NaNs and INFs in energy calculation.
4958 C Find the largest exponent
4962 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4966 cd print *,'it=',it,' emin=',emin
4968 C Compute the contribution to SC energy and derivatives
4973 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
4974 if(adexp.ne.adexp) adexp=1.0
4977 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4979 cd print *,'j=',j,' expfac=',expfac
4980 escloc_i=escloc_i+expfac
4982 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4986 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4987 & +gaussc(k,2,j,it))*expfac
4994 dersc(1)=dersc(1)/cos(theti)**2
4995 ddersc(1)=ddersc(1)/cos(theti)**2
4998 escloci=-(dlog(escloc_i)-emin)
5000 dersc(j)=dersc(j)/escloc_i
5004 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5009 C------------------------------------------------------------------------------
5010 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5011 implicit real*8 (a-h,o-z)
5012 include 'DIMENSIONS'
5013 include 'COMMON.GEO'
5014 include 'COMMON.LOCAL'
5015 include 'COMMON.IOUNITS'
5016 common /sccalc/ time11,time12,time112,theti,it,nlobit
5017 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5018 double precision contr(maxlob)
5029 z(k)=x(k)-censc(k,j,it)
5035 Axk=Axk+gaussc(l,k,j,it)*z(l)
5041 expfac=expfac+Ax(k,j)*z(k)
5046 C As in the case of ebend, we want to avoid underflows in exponentiation and
5047 C subsequent NaNs and INFs in energy calculation.
5048 C Find the largest exponent
5051 if (emin.gt.contr(j)) emin=contr(j)
5055 C Compute the contribution to SC energy and derivatives
5059 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5060 escloc_i=escloc_i+expfac
5062 dersc(k)=dersc(k)+Ax(k,j)*expfac
5064 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5065 & +gaussc(1,2,j,it))*expfac
5069 dersc(1)=dersc(1)/cos(theti)**2
5070 dersc12=dersc12/cos(theti)**2
5071 escloci=-(dlog(escloc_i)-emin)
5073 dersc(j)=dersc(j)/escloc_i
5075 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5079 c----------------------------------------------------------------------------------
5080 subroutine esc(escloc)
5081 C Calculate the local energy of a side chain and its derivatives in the
5082 C corresponding virtual-bond valence angles THETA and the spherical angles
5083 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5084 C added by Urszula Kozlowska. 07/11/2007
5086 implicit real*8 (a-h,o-z)
5087 include 'DIMENSIONS'
5088 include 'COMMON.GEO'
5089 include 'COMMON.LOCAL'
5090 include 'COMMON.VAR'
5091 include 'COMMON.SCROT'
5092 include 'COMMON.INTERACT'
5093 include 'COMMON.DERIV'
5094 include 'COMMON.CHAIN'
5095 include 'COMMON.IOUNITS'
5096 include 'COMMON.NAMES'
5097 include 'COMMON.FFIELD'
5098 include 'COMMON.CONTROL'
5099 include 'COMMON.VECTORS'
5100 double precision x_prime(3),y_prime(3),z_prime(3)
5101 & , sumene,dsc_i,dp2_i,x(65),
5102 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5103 & de_dxx,de_dyy,de_dzz,de_dt
5104 double precision s1_t,s1_6_t,s2_t,s2_6_t
5106 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5107 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5108 & dt_dCi(3),dt_dCi1(3)
5109 common /sccalc/ time11,time12,time112,theti,it,nlobit
5112 do i=loc_start,loc_end
5113 if (itype(i).eq.ntyp1) cycle
5114 costtab(i+1) =dcos(theta(i+1))
5115 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5116 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5117 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5118 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5119 cosfac=dsqrt(cosfac2)
5120 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5121 sinfac=dsqrt(sinfac2)
5123 if (it.eq.10) goto 1
5125 C Compute the axes of tghe local cartesian coordinates system; store in
5126 c x_prime, y_prime and z_prime
5133 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5134 C & dc_norm(3,i+nres)
5136 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5137 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5140 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5143 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5144 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5145 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5146 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5147 c & " xy",scalar(x_prime(1),y_prime(1)),
5148 c & " xz",scalar(x_prime(1),z_prime(1)),
5149 c & " yy",scalar(y_prime(1),y_prime(1)),
5150 c & " yz",scalar(y_prime(1),z_prime(1)),
5151 c & " zz",scalar(z_prime(1),z_prime(1))
5153 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5154 C to local coordinate system. Store in xx, yy, zz.
5160 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5161 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5162 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5169 C Compute the energy of the ith side cbain
5171 c write (2,*) "xx",xx," yy",yy," zz",zz
5174 x(j) = sc_parmin(j,it)
5177 Cc diagnostics - remove later
5179 yy1 = dsin(alph(2))*dcos(omeg(2))
5180 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5181 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5182 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5184 C," --- ", xx_w,yy_w,zz_w
5187 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5188 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5190 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5191 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5193 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5194 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5195 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5196 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5197 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5199 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5200 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5201 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5202 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5203 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5205 dsc_i = 0.743d0+x(61)
5207 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5208 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5209 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5210 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5211 s1=(1+x(63))/(0.1d0 + dscp1)
5212 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5213 s2=(1+x(65))/(0.1d0 + dscp2)
5214 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5215 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5216 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5217 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5219 c & dscp1,dscp2,sumene
5220 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5221 escloc = escloc + sumene
5222 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5227 C This section to check the numerical derivatives of the energy of ith side
5228 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5229 C #define DEBUG in the code to turn it on.
5231 write (2,*) "sumene =",sumene
5235 write (2,*) xx,yy,zz
5236 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5237 de_dxx_num=(sumenep-sumene)/aincr
5239 write (2,*) "xx+ sumene from enesc=",sumenep
5242 write (2,*) xx,yy,zz
5243 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5244 de_dyy_num=(sumenep-sumene)/aincr
5246 write (2,*) "yy+ sumene from enesc=",sumenep
5249 write (2,*) xx,yy,zz
5250 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5251 de_dzz_num=(sumenep-sumene)/aincr
5253 write (2,*) "zz+ sumene from enesc=",sumenep
5254 costsave=cost2tab(i+1)
5255 sintsave=sint2tab(i+1)
5256 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5257 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5258 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5259 de_dt_num=(sumenep-sumene)/aincr
5260 write (2,*) " t+ sumene from enesc=",sumenep
5261 cost2tab(i+1)=costsave
5262 sint2tab(i+1)=sintsave
5263 C End of diagnostics section.
5266 C Compute the gradient of esc
5268 c zz=zz*dsign(1.0,dfloat(itype(i)))
5269 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5270 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5271 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5272 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5273 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5274 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5275 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5276 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5277 pom1=(sumene3*sint2tab(i+1)+sumene1)
5278 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5279 pom2=(sumene4*cost2tab(i+1)+sumene2)
5280 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5281 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5282 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5283 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5285 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5286 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5287 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5289 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5290 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5291 & +(pom1+pom2)*pom_dx
5293 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5296 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5297 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5298 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5300 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5301 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5302 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5303 & +x(59)*zz**2 +x(60)*xx*zz
5304 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5305 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5306 & +(pom1-pom2)*pom_dy
5308 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5311 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5312 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5313 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5314 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5315 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5316 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5317 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5318 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5320 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5323 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5324 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5325 & +pom1*pom_dt1+pom2*pom_dt2
5327 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5332 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5333 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5334 cosfac2xx=cosfac2*xx
5335 sinfac2yy=sinfac2*yy
5337 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5339 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5341 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5342 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5343 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5344 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5345 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5346 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5347 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5348 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5349 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5350 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5354 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5355 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5356 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5357 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5360 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5361 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5362 dZZ_XYZ(k)=vbld_inv(i+nres)*
5363 & (z_prime(k)-zz*dC_norm(k,i+nres))
5365 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5366 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5370 dXX_Ctab(k,i)=dXX_Ci(k)
5371 dXX_C1tab(k,i)=dXX_Ci1(k)
5372 dYY_Ctab(k,i)=dYY_Ci(k)
5373 dYY_C1tab(k,i)=dYY_Ci1(k)
5374 dZZ_Ctab(k,i)=dZZ_Ci(k)
5375 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5376 dXX_XYZtab(k,i)=dXX_XYZ(k)
5377 dYY_XYZtab(k,i)=dYY_XYZ(k)
5378 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5382 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5383 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5384 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5385 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5386 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5388 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5389 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5390 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5391 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5392 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5393 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5394 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5395 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5397 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5398 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5400 C to check gradient call subroutine check_grad
5406 c------------------------------------------------------------------------------
5407 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5409 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5410 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5411 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5412 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5414 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5415 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5417 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5418 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5419 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5420 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5421 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5423 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5424 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5425 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5426 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5427 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5429 dsc_i = 0.743d0+x(61)
5431 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5432 & *(xx*cost2+yy*sint2))
5433 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5434 & *(xx*cost2-yy*sint2))
5435 s1=(1+x(63))/(0.1d0 + dscp1)
5436 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5437 s2=(1+x(65))/(0.1d0 + dscp2)
5438 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5439 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5440 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5445 c------------------------------------------------------------------------------
5446 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5448 C This procedure calculates two-body contact function g(rij) and its derivative:
5451 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5454 C where x=(rij-r0ij)/delta
5456 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5459 double precision rij,r0ij,eps0ij,fcont,fprimcont
5460 double precision x,x2,x4,delta
5464 if (x.lt.-1.0D0) then
5467 else if (x.le.1.0D0) then
5470 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5471 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5478 c------------------------------------------------------------------------------
5479 subroutine splinthet(theti,delta,ss,ssder)
5480 implicit real*8 (a-h,o-z)
5481 include 'DIMENSIONS'
5482 include 'COMMON.VAR'
5483 include 'COMMON.GEO'
5486 if (theti.gt.pipol) then
5487 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5489 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5494 c------------------------------------------------------------------------------
5495 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5497 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5498 double precision ksi,ksi2,ksi3,a1,a2,a3
5499 a1=fprim0*delta/(f1-f0)
5505 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5506 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5509 c------------------------------------------------------------------------------
5510 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5512 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5513 double precision ksi,ksi2,ksi3,a1,a2,a3
5518 a2=3*(f1x-f0x)-2*fprim0x*delta
5519 a3=fprim0x*delta-2*(f1x-f0x)
5520 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5523 C-----------------------------------------------------------------------------
5525 C-----------------------------------------------------------------------------
5526 subroutine etor(etors,edihcnstr)
5527 implicit real*8 (a-h,o-z)
5528 include 'DIMENSIONS'
5529 include 'COMMON.VAR'
5530 include 'COMMON.GEO'
5531 include 'COMMON.LOCAL'
5532 include 'COMMON.TORSION'
5533 include 'COMMON.INTERACT'
5534 include 'COMMON.DERIV'
5535 include 'COMMON.CHAIN'
5536 include 'COMMON.NAMES'
5537 include 'COMMON.IOUNITS'
5538 include 'COMMON.FFIELD'
5539 include 'COMMON.TORCNSTR'
5540 include 'COMMON.CONTROL'
5542 C Set lprn=.true. for debugging
5546 do i=iphi_start,iphi_end
5548 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5549 & .or. itype(i).eq.ntyp1) cycle
5550 itori=itortyp(itype(i-2))
5551 itori1=itortyp(itype(i-1))
5554 C Proline-Proline pair is a special case...
5555 if (itori.eq.3 .and. itori1.eq.3) then
5556 if (phii.gt.-dwapi3) then
5558 fac=1.0D0/(1.0D0-cosphi)
5559 etorsi=v1(1,3,3)*fac
5560 etorsi=etorsi+etorsi
5561 etors=etors+etorsi-v1(1,3,3)
5562 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5563 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5566 v1ij=v1(j+1,itori,itori1)
5567 v2ij=v2(j+1,itori,itori1)
5570 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5571 if (energy_dec) etors_ii=etors_ii+
5572 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5573 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5577 v1ij=v1(j,itori,itori1)
5578 v2ij=v2(j,itori,itori1)
5581 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5582 if (energy_dec) etors_ii=etors_ii+
5583 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5584 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5587 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5590 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5591 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5592 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5593 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5594 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5596 ! 6/20/98 - dihedral angle constraints
5599 itori=idih_constr(i)
5602 if (difi.gt.drange(i)) then
5604 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5605 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5606 else if (difi.lt.-drange(i)) then
5608 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5609 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5611 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5612 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5614 ! write (iout,*) 'edihcnstr',edihcnstr
5617 c------------------------------------------------------------------------------
5618 subroutine etor_d(etors_d)
5622 c----------------------------------------------------------------------------
5624 subroutine etor(etors,edihcnstr)
5625 implicit real*8 (a-h,o-z)
5626 include 'DIMENSIONS'
5627 include 'COMMON.VAR'
5628 include 'COMMON.GEO'
5629 include 'COMMON.LOCAL'
5630 include 'COMMON.TORSION'
5631 include 'COMMON.INTERACT'
5632 include 'COMMON.DERIV'
5633 include 'COMMON.CHAIN'
5634 include 'COMMON.NAMES'
5635 include 'COMMON.IOUNITS'
5636 include 'COMMON.FFIELD'
5637 include 'COMMON.TORCNSTR'
5638 include 'COMMON.CONTROL'
5640 C Set lprn=.true. for debugging
5644 do i=iphi_start,iphi_end
5645 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5646 & .or. itype(i).eq.ntyp1) cycle
5648 if (iabs(itype(i)).eq.20) then
5653 itori=itortyp(itype(i-2))
5654 itori1=itortyp(itype(i-1))
5657 C Regular cosine and sine terms
5658 do j=1,nterm(itori,itori1,iblock)
5659 v1ij=v1(j,itori,itori1,iblock)
5660 v2ij=v2(j,itori,itori1,iblock)
5663 etors=etors+v1ij*cosphi+v2ij*sinphi
5664 if (energy_dec) etors_ii=etors_ii+
5665 & v1ij*cosphi+v2ij*sinphi
5666 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5670 C E = SUM ----------------------------------- - v1
5671 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5673 cosphi=dcos(0.5d0*phii)
5674 sinphi=dsin(0.5d0*phii)
5675 do j=1,nlor(itori,itori1,iblock)
5676 vl1ij=vlor1(j,itori,itori1)
5677 vl2ij=vlor2(j,itori,itori1)
5678 vl3ij=vlor3(j,itori,itori1)
5679 pom=vl2ij*cosphi+vl3ij*sinphi
5680 pom1=1.0d0/(pom*pom+1.0d0)
5681 etors=etors+vl1ij*pom1
5682 if (energy_dec) etors_ii=etors_ii+
5685 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5687 C Subtract the constant term
5688 etors=etors-v0(itori,itori1,iblock)
5689 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5690 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5692 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5693 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5694 & (v1(j,itori,itori1,iblock),j=1,6),
5695 & (v2(j,itori,itori1,iblock),j=1,6)
5696 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5697 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5699 ! 6/20/98 - dihedral angle constraints
5701 c do i=1,ndih_constr
5702 do i=idihconstr_start,idihconstr_end
5703 itori=idih_constr(i)
5705 difi=pinorm(phii-phi0(i))
5706 if (difi.gt.drange(i)) then
5708 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5709 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5710 else if (difi.lt.-drange(i)) then
5712 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5713 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5717 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5718 cd & rad2deg*phi0(i), rad2deg*drange(i),
5719 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5721 cd write (iout,*) 'edihcnstr',edihcnstr
5724 c----------------------------------------------------------------------------
5725 subroutine etor_d(etors_d)
5726 C 6/23/01 Compute double torsional energy
5727 implicit real*8 (a-h,o-z)
5728 include 'DIMENSIONS'
5729 include 'COMMON.VAR'
5730 include 'COMMON.GEO'
5731 include 'COMMON.LOCAL'
5732 include 'COMMON.TORSION'
5733 include 'COMMON.INTERACT'
5734 include 'COMMON.DERIV'
5735 include 'COMMON.CHAIN'
5736 include 'COMMON.NAMES'
5737 include 'COMMON.IOUNITS'
5738 include 'COMMON.FFIELD'
5739 include 'COMMON.TORCNSTR'
5741 C Set lprn=.true. for debugging
5745 c write(iout,*) "a tu??"
5746 do i=iphid_start,iphid_end
5747 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5748 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5749 itori=itortyp(itype(i-2))
5750 itori1=itortyp(itype(i-1))
5751 itori2=itortyp(itype(i))
5757 if (iabs(itype(i+1)).eq.20) iblock=2
5759 C Regular cosine and sine terms
5760 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5761 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5762 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5763 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5764 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5765 cosphi1=dcos(j*phii)
5766 sinphi1=dsin(j*phii)
5767 cosphi2=dcos(j*phii1)
5768 sinphi2=dsin(j*phii1)
5769 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5770 & v2cij*cosphi2+v2sij*sinphi2
5771 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5772 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5774 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5776 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5777 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5778 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5779 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5780 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5781 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5782 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5783 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5784 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5785 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5786 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5787 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5788 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5789 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5792 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5793 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5798 c------------------------------------------------------------------------------
5799 subroutine eback_sc_corr(esccor)
5800 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5801 c conformational states; temporarily implemented as differences
5802 c between UNRES torsional potentials (dependent on three types of
5803 c residues) and the torsional potentials dependent on all 20 types
5804 c of residues computed from AM1 energy surfaces of terminally-blocked
5805 c amino-acid residues.
5806 implicit real*8 (a-h,o-z)
5807 include 'DIMENSIONS'
5808 include 'COMMON.VAR'
5809 include 'COMMON.GEO'
5810 include 'COMMON.LOCAL'
5811 include 'COMMON.TORSION'
5812 include 'COMMON.SCCOR'
5813 include 'COMMON.INTERACT'
5814 include 'COMMON.DERIV'
5815 include 'COMMON.CHAIN'
5816 include 'COMMON.NAMES'
5817 include 'COMMON.IOUNITS'
5818 include 'COMMON.FFIELD'
5819 include 'COMMON.CONTROL'
5821 C Set lprn=.true. for debugging
5824 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5826 do i=itau_start,itau_end
5827 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5829 isccori=isccortyp(itype(i-2))
5830 isccori1=isccortyp(itype(i-1))
5831 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5833 do intertyp=1,3 !intertyp
5834 cc Added 09 May 2012 (Adasko)
5835 cc Intertyp means interaction type of backbone mainchain correlation:
5836 c 1 = SC...Ca...Ca...Ca
5837 c 2 = Ca...Ca...Ca...SC
5838 c 3 = SC...Ca...Ca...SCi
5840 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5841 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5842 & (itype(i-1).eq.ntyp1)))
5843 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5844 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5845 & .or.(itype(i).eq.ntyp1)))
5846 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5847 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5848 & (itype(i-3).eq.ntyp1)))) cycle
5849 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5850 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5852 do j=1,nterm_sccor(isccori,isccori1)
5853 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5854 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5855 cosphi=dcos(j*tauangle(intertyp,i))
5856 sinphi=dsin(j*tauangle(intertyp,i))
5857 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5858 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5860 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5861 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5863 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5864 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
5865 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
5866 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5867 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5873 c----------------------------------------------------------------------------
5874 subroutine multibody(ecorr)
5875 C This subroutine calculates multi-body contributions to energy following
5876 C the idea of Skolnick et al. If side chains I and J make a contact and
5877 C at the same time side chains I+1 and J+1 make a contact, an extra
5878 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5879 implicit real*8 (a-h,o-z)
5880 include 'DIMENSIONS'
5881 include 'COMMON.IOUNITS'
5882 include 'COMMON.DERIV'
5883 include 'COMMON.INTERACT'
5884 include 'COMMON.CONTACTS'
5885 double precision gx(3),gx1(3)
5888 C Set lprn=.true. for debugging
5892 write (iout,'(a)') 'Contact function values:'
5894 write (iout,'(i2,20(1x,i2,f10.5))')
5895 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5910 num_conti=num_cont(i)
5911 num_conti1=num_cont(i1)
5916 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5917 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5918 cd & ' ishift=',ishift
5919 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5920 C The system gains extra energy.
5921 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5922 endif ! j1==j+-ishift
5931 c------------------------------------------------------------------------------
5932 double precision function esccorr(i,j,k,l,jj,kk)
5933 implicit real*8 (a-h,o-z)
5934 include 'DIMENSIONS'
5935 include 'COMMON.IOUNITS'
5936 include 'COMMON.DERIV'
5937 include 'COMMON.INTERACT'
5938 include 'COMMON.CONTACTS'
5939 double precision gx(3),gx1(3)
5944 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5945 C Calculate the multi-body contribution to energy.
5946 C Calculate multi-body contributions to the gradient.
5947 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5948 cd & k,l,(gacont(m,kk,k),m=1,3)
5950 gx(m) =ekl*gacont(m,jj,i)
5951 gx1(m)=eij*gacont(m,kk,k)
5952 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5953 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5954 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5955 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5959 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5964 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5970 c------------------------------------------------------------------------------
5971 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5972 C This subroutine calculates multi-body contributions to hydrogen-bonding
5973 implicit real*8 (a-h,o-z)
5974 include 'DIMENSIONS'
5975 include 'COMMON.IOUNITS'
5978 parameter (max_cont=maxconts)
5979 parameter (max_dim=26)
5980 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5981 double precision zapas(max_dim,maxconts,max_fg_procs),
5982 & zapas_recv(max_dim,maxconts,max_fg_procs)
5983 common /przechowalnia/ zapas
5984 integer status(MPI_STATUS_SIZE),req(maxconts*2),
5985 & status_array(MPI_STATUS_SIZE,maxconts*2)
5987 include 'COMMON.SETUP'
5988 include 'COMMON.FFIELD'
5989 include 'COMMON.DERIV'
5990 include 'COMMON.INTERACT'
5991 include 'COMMON.CONTACTS'
5992 include 'COMMON.CONTROL'
5993 include 'COMMON.LOCAL'
5994 double precision gx(3),gx1(3),time00
5997 C Set lprn=.true. for debugging
6002 if (nfgtasks.le.1) goto 30
6004 write (iout,'(a)') 'Contact function values before RECEIVE:'
6006 write (iout,'(2i3,50(1x,i2,f5.2))')
6007 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6008 & j=1,num_cont_hb(i))
6012 do i=1,ntask_cont_from
6015 do i=1,ntask_cont_to
6018 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6020 C Make the list of contacts to send to send to other procesors
6021 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6023 do i=iturn3_start,iturn3_end
6024 c write (iout,*) "make contact list turn3",i," num_cont",
6026 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6028 do i=iturn4_start,iturn4_end
6029 c write (iout,*) "make contact list turn4",i," num_cont",
6031 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6035 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6037 do j=1,num_cont_hb(i)
6040 iproc=iint_sent_local(k,jjc,ii)
6041 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6042 if (iproc.gt.0) then
6043 ncont_sent(iproc)=ncont_sent(iproc)+1
6044 nn=ncont_sent(iproc)
6046 zapas(2,nn,iproc)=jjc
6047 zapas(3,nn,iproc)=facont_hb(j,i)
6048 zapas(4,nn,iproc)=ees0p(j,i)
6049 zapas(5,nn,iproc)=ees0m(j,i)
6050 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6051 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6052 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6053 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6054 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6055 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6056 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6057 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6058 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6059 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6060 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6061 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6062 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6063 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6064 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6065 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6066 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6067 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6068 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6069 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6070 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6077 & "Numbers of contacts to be sent to other processors",
6078 & (ncont_sent(i),i=1,ntask_cont_to)
6079 write (iout,*) "Contacts sent"
6080 do ii=1,ntask_cont_to
6082 iproc=itask_cont_to(ii)
6083 write (iout,*) nn," contacts to processor",iproc,
6084 & " of CONT_TO_COMM group"
6086 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6094 CorrelID1=nfgtasks+fg_rank+1
6096 C Receive the numbers of needed contacts from other processors
6097 do ii=1,ntask_cont_from
6098 iproc=itask_cont_from(ii)
6100 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6101 & FG_COMM,req(ireq),IERR)
6103 c write (iout,*) "IRECV ended"
6105 C Send the number of contacts needed by other processors
6106 do ii=1,ntask_cont_to
6107 iproc=itask_cont_to(ii)
6109 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6110 & FG_COMM,req(ireq),IERR)
6112 c write (iout,*) "ISEND ended"
6113 c write (iout,*) "number of requests (nn)",ireq
6116 & call MPI_Waitall(ireq,req,status_array,ierr)
6118 c & "Numbers of contacts to be received from other processors",
6119 c & (ncont_recv(i),i=1,ntask_cont_from)
6123 do ii=1,ntask_cont_from
6124 iproc=itask_cont_from(ii)
6126 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6127 c & " of CONT_TO_COMM group"
6131 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6132 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6133 c write (iout,*) "ireq,req",ireq,req(ireq)
6136 C Send the contacts to processors that need them
6137 do ii=1,ntask_cont_to
6138 iproc=itask_cont_to(ii)
6140 c write (iout,*) nn," contacts to processor",iproc,
6141 c & " of CONT_TO_COMM group"
6144 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6145 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6146 c write (iout,*) "ireq,req",ireq,req(ireq)
6148 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6152 c write (iout,*) "number of requests (contacts)",ireq
6153 c write (iout,*) "req",(req(i),i=1,4)
6156 & call MPI_Waitall(ireq,req,status_array,ierr)
6157 do iii=1,ntask_cont_from
6158 iproc=itask_cont_from(iii)
6161 write (iout,*) "Received",nn," contacts from processor",iproc,
6162 & " of CONT_FROM_COMM group"
6165 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6170 ii=zapas_recv(1,i,iii)
6171 c Flag the received contacts to prevent double-counting
6172 jj=-zapas_recv(2,i,iii)
6173 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6175 nnn=num_cont_hb(ii)+1
6178 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6179 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6180 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6181 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6182 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6183 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6184 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6185 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6186 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6187 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6188 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6189 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6190 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6191 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6192 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6193 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6194 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6195 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6196 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6197 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6198 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6199 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6200 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6201 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6206 write (iout,'(a)') 'Contact function values after receive:'
6208 write (iout,'(2i3,50(1x,i3,f5.2))')
6209 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6210 & j=1,num_cont_hb(i))
6217 write (iout,'(a)') 'Contact function values:'
6219 write (iout,'(2i3,50(1x,i3,f5.2))')
6220 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6221 & j=1,num_cont_hb(i))
6225 C Remove the loop below after debugging !!!
6232 C Calculate the local-electrostatic correlation terms
6233 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6235 num_conti=num_cont_hb(i)
6236 num_conti1=num_cont_hb(i+1)
6243 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6244 c & ' jj=',jj,' kk=',kk
6245 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6246 & .or. j.lt.0 .and. j1.gt.0) .and.
6247 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6248 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6249 C The system gains extra energy.
6250 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6251 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6252 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6254 else if (j1.eq.j) then
6255 C Contacts I-J and I-(J+1) occur simultaneously.
6256 C The system loses extra energy.
6257 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6262 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6263 c & ' jj=',jj,' kk=',kk
6265 C Contacts I-J and (I+1)-J occur simultaneously.
6266 C The system loses extra energy.
6267 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6274 c------------------------------------------------------------------------------
6275 subroutine add_hb_contact(ii,jj,itask)
6276 implicit real*8 (a-h,o-z)
6277 include "DIMENSIONS"
6278 include "COMMON.IOUNITS"
6281 parameter (max_cont=maxconts)
6282 parameter (max_dim=26)
6283 include "COMMON.CONTACTS"
6284 double precision zapas(max_dim,maxconts,max_fg_procs),
6285 & zapas_recv(max_dim,maxconts,max_fg_procs)
6286 common /przechowalnia/ zapas
6287 integer i,j,ii,jj,iproc,itask(4),nn
6288 c write (iout,*) "itask",itask
6291 if (iproc.gt.0) then
6292 do j=1,num_cont_hb(ii)
6294 c write (iout,*) "i",ii," j",jj," jjc",jjc
6296 ncont_sent(iproc)=ncont_sent(iproc)+1
6297 nn=ncont_sent(iproc)
6298 zapas(1,nn,iproc)=ii
6299 zapas(2,nn,iproc)=jjc
6300 zapas(3,nn,iproc)=facont_hb(j,ii)
6301 zapas(4,nn,iproc)=ees0p(j,ii)
6302 zapas(5,nn,iproc)=ees0m(j,ii)
6303 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6304 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6305 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6306 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6307 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6308 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6309 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6310 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6311 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6312 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6313 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6314 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6315 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6316 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6317 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6318 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6319 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6320 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6321 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6322 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6323 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6331 c------------------------------------------------------------------------------
6332 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6334 C This subroutine calculates multi-body contributions to hydrogen-bonding
6335 implicit real*8 (a-h,o-z)
6336 include 'DIMENSIONS'
6337 include 'COMMON.IOUNITS'
6340 parameter (max_cont=maxconts)
6341 parameter (max_dim=70)
6342 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6343 double precision zapas(max_dim,maxconts,max_fg_procs),
6344 & zapas_recv(max_dim,maxconts,max_fg_procs)
6345 common /przechowalnia/ zapas
6346 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6347 & status_array(MPI_STATUS_SIZE,maxconts*2)
6349 include 'COMMON.SETUP'
6350 include 'COMMON.FFIELD'
6351 include 'COMMON.DERIV'
6352 include 'COMMON.LOCAL'
6353 include 'COMMON.INTERACT'
6354 include 'COMMON.CONTACTS'
6355 include 'COMMON.CHAIN'
6356 include 'COMMON.CONTROL'
6357 double precision gx(3),gx1(3)
6358 integer num_cont_hb_old(maxres)
6360 double precision eello4,eello5,eelo6,eello_turn6
6361 external eello4,eello5,eello6,eello_turn6
6362 C Set lprn=.true. for debugging
6367 num_cont_hb_old(i)=num_cont_hb(i)
6371 if (nfgtasks.le.1) goto 30
6373 write (iout,'(a)') 'Contact function values before RECEIVE:'
6375 write (iout,'(2i3,50(1x,i2,f5.2))')
6376 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6377 & j=1,num_cont_hb(i))
6381 do i=1,ntask_cont_from
6384 do i=1,ntask_cont_to
6387 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6389 C Make the list of contacts to send to send to other procesors
6390 do i=iturn3_start,iturn3_end
6391 c write (iout,*) "make contact list turn3",i," num_cont",
6393 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6395 do i=iturn4_start,iturn4_end
6396 c write (iout,*) "make contact list turn4",i," num_cont",
6398 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6402 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6404 do j=1,num_cont_hb(i)
6407 iproc=iint_sent_local(k,jjc,ii)
6408 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6409 if (iproc.ne.0) then
6410 ncont_sent(iproc)=ncont_sent(iproc)+1
6411 nn=ncont_sent(iproc)
6413 zapas(2,nn,iproc)=jjc
6414 zapas(3,nn,iproc)=d_cont(j,i)
6418 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6423 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6431 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6442 & "Numbers of contacts to be sent to other processors",
6443 & (ncont_sent(i),i=1,ntask_cont_to)
6444 write (iout,*) "Contacts sent"
6445 do ii=1,ntask_cont_to
6447 iproc=itask_cont_to(ii)
6448 write (iout,*) nn," contacts to processor",iproc,
6449 & " of CONT_TO_COMM group"
6451 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6459 CorrelID1=nfgtasks+fg_rank+1
6461 C Receive the numbers of needed contacts from other processors
6462 do ii=1,ntask_cont_from
6463 iproc=itask_cont_from(ii)
6465 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6466 & FG_COMM,req(ireq),IERR)
6468 c write (iout,*) "IRECV ended"
6470 C Send the number of contacts needed by other processors
6471 do ii=1,ntask_cont_to
6472 iproc=itask_cont_to(ii)
6474 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6475 & FG_COMM,req(ireq),IERR)
6477 c write (iout,*) "ISEND ended"
6478 c write (iout,*) "number of requests (nn)",ireq
6481 & call MPI_Waitall(ireq,req,status_array,ierr)
6483 c & "Numbers of contacts to be received from other processors",
6484 c & (ncont_recv(i),i=1,ntask_cont_from)
6488 do ii=1,ntask_cont_from
6489 iproc=itask_cont_from(ii)
6491 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6492 c & " of CONT_TO_COMM group"
6496 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6497 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6498 c write (iout,*) "ireq,req",ireq,req(ireq)
6501 C Send the contacts to processors that need them
6502 do ii=1,ntask_cont_to
6503 iproc=itask_cont_to(ii)
6505 c write (iout,*) nn," contacts to processor",iproc,
6506 c & " of CONT_TO_COMM group"
6509 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6510 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6511 c write (iout,*) "ireq,req",ireq,req(ireq)
6513 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6517 c write (iout,*) "number of requests (contacts)",ireq
6518 c write (iout,*) "req",(req(i),i=1,4)
6521 & call MPI_Waitall(ireq,req,status_array,ierr)
6522 do iii=1,ntask_cont_from
6523 iproc=itask_cont_from(iii)
6526 write (iout,*) "Received",nn," contacts from processor",iproc,
6527 & " of CONT_FROM_COMM group"
6530 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6535 ii=zapas_recv(1,i,iii)
6536 c Flag the received contacts to prevent double-counting
6537 jj=-zapas_recv(2,i,iii)
6538 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6540 nnn=num_cont_hb(ii)+1
6543 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6547 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6552 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6560 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6569 write (iout,'(a)') 'Contact function values after receive:'
6571 write (iout,'(2i3,50(1x,i3,5f6.3))')
6572 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6573 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6580 write (iout,'(a)') 'Contact function values:'
6582 write (iout,'(2i3,50(1x,i2,5f6.3))')
6583 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6584 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6590 C Remove the loop below after debugging !!!
6597 C Calculate the dipole-dipole interaction energies
6598 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6599 do i=iatel_s,iatel_e+1
6600 num_conti=num_cont_hb(i)
6609 C Calculate the local-electrostatic correlation terms
6610 c write (iout,*) "gradcorr5 in eello5 before loop"
6612 c write (iout,'(i5,3f10.5)')
6613 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6615 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6616 c write (iout,*) "corr loop i",i
6618 num_conti=num_cont_hb(i)
6619 num_conti1=num_cont_hb(i+1)
6626 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6627 c & ' jj=',jj,' kk=',kk
6628 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6629 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6630 & .or. j.lt.0 .and. j1.gt.0) .and.
6631 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6632 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6633 C The system gains extra energy.
6635 sqd1=dsqrt(d_cont(jj,i))
6636 sqd2=dsqrt(d_cont(kk,i1))
6637 sred_geom = sqd1*sqd2
6638 IF (sred_geom.lt.cutoff_corr) THEN
6639 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6641 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6642 cd & ' jj=',jj,' kk=',kk
6643 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6644 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6646 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6647 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6650 cd write (iout,*) 'sred_geom=',sred_geom,
6651 cd & ' ekont=',ekont,' fprim=',fprimcont,
6652 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6653 cd write (iout,*) "g_contij",g_contij
6654 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6655 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6656 call calc_eello(i,jp,i+1,jp1,jj,kk)
6657 if (wcorr4.gt.0.0d0)
6658 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6659 if (energy_dec.and.wcorr4.gt.0.0d0)
6660 1 write (iout,'(a6,4i5,0pf7.3)')
6661 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6662 c write (iout,*) "gradcorr5 before eello5"
6664 c write (iout,'(i5,3f10.5)')
6665 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6667 if (wcorr5.gt.0.0d0)
6668 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6669 c write (iout,*) "gradcorr5 after eello5"
6671 c write (iout,'(i5,3f10.5)')
6672 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6674 if (energy_dec.and.wcorr5.gt.0.0d0)
6675 1 write (iout,'(a6,4i5,0pf7.3)')
6676 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6677 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6678 cd write(2,*)'ijkl',i,jp,i+1,jp1
6679 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6680 & .or. wturn6.eq.0.0d0))then
6681 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6682 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6683 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6684 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6685 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6686 cd & 'ecorr6=',ecorr6
6687 cd write (iout,'(4e15.5)') sred_geom,
6688 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6689 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6690 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6691 else if (wturn6.gt.0.0d0
6692 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6693 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6694 eturn6=eturn6+eello_turn6(i,jj,kk)
6695 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6696 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6697 cd write (2,*) 'multibody_eello:eturn6',eturn6
6706 num_cont_hb(i)=num_cont_hb_old(i)
6708 c write (iout,*) "gradcorr5 in eello5"
6710 c write (iout,'(i5,3f10.5)')
6711 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6715 c------------------------------------------------------------------------------
6716 subroutine add_hb_contact_eello(ii,jj,itask)
6717 implicit real*8 (a-h,o-z)
6718 include "DIMENSIONS"
6719 include "COMMON.IOUNITS"
6722 parameter (max_cont=maxconts)
6723 parameter (max_dim=70)
6724 include "COMMON.CONTACTS"
6725 double precision zapas(max_dim,maxconts,max_fg_procs),
6726 & zapas_recv(max_dim,maxconts,max_fg_procs)
6727 common /przechowalnia/ zapas
6728 integer i,j,ii,jj,iproc,itask(4),nn
6729 c write (iout,*) "itask",itask
6732 if (iproc.gt.0) then
6733 do j=1,num_cont_hb(ii)
6735 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6737 ncont_sent(iproc)=ncont_sent(iproc)+1
6738 nn=ncont_sent(iproc)
6739 zapas(1,nn,iproc)=ii
6740 zapas(2,nn,iproc)=jjc
6741 zapas(3,nn,iproc)=d_cont(j,ii)
6745 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6750 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6758 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6770 c------------------------------------------------------------------------------
6771 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6772 implicit real*8 (a-h,o-z)
6773 include 'DIMENSIONS'
6774 include 'COMMON.IOUNITS'
6775 include 'COMMON.DERIV'
6776 include 'COMMON.INTERACT'
6777 include 'COMMON.CONTACTS'
6778 double precision gx(3),gx1(3)
6788 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6789 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6790 C Following 4 lines for diagnostics.
6795 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6796 c & 'Contacts ',i,j,
6797 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6798 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6800 C Calculate the multi-body contribution to energy.
6801 c ecorr=ecorr+ekont*ees
6802 C Calculate multi-body contributions to the gradient.
6803 coeffpees0pij=coeffp*ees0pij
6804 coeffmees0mij=coeffm*ees0mij
6805 coeffpees0pkl=coeffp*ees0pkl
6806 coeffmees0mkl=coeffm*ees0mkl
6808 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6809 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6810 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6811 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6812 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6813 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6814 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6815 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6816 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6817 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6818 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6819 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6820 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6821 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6822 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6823 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6824 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6825 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6826 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6827 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6828 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6829 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6830 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6831 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6832 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6837 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6838 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6839 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6840 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6845 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6846 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6847 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6848 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6851 c write (iout,*) "ehbcorr",ekont*ees
6856 C---------------------------------------------------------------------------
6857 subroutine dipole(i,j,jj)
6858 implicit real*8 (a-h,o-z)
6859 include 'DIMENSIONS'
6860 include 'COMMON.IOUNITS'
6861 include 'COMMON.CHAIN'
6862 include 'COMMON.FFIELD'
6863 include 'COMMON.DERIV'
6864 include 'COMMON.INTERACT'
6865 include 'COMMON.CONTACTS'
6866 include 'COMMON.TORSION'
6867 include 'COMMON.VAR'
6868 include 'COMMON.GEO'
6869 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6871 iti1 = itortyp(itype(i+1))
6872 if (j.lt.nres-1) then
6873 itj1 = itortyp(itype(j+1))
6878 dipi(iii,1)=Ub2(iii,i)
6879 dipderi(iii)=Ub2der(iii,i)
6880 dipi(iii,2)=b1(iii,iti1)
6881 dipj(iii,1)=Ub2(iii,j)
6882 dipderj(iii)=Ub2der(iii,j)
6883 dipj(iii,2)=b1(iii,itj1)
6887 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6890 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6897 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6901 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6906 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6907 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6909 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6911 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6913 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6918 C---------------------------------------------------------------------------
6919 subroutine calc_eello(i,j,k,l,jj,kk)
6921 C This subroutine computes matrices and vectors needed to calculate
6922 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6924 implicit real*8 (a-h,o-z)
6925 include 'DIMENSIONS'
6926 include 'COMMON.IOUNITS'
6927 include 'COMMON.CHAIN'
6928 include 'COMMON.DERIV'
6929 include 'COMMON.INTERACT'
6930 include 'COMMON.CONTACTS'
6931 include 'COMMON.TORSION'
6932 include 'COMMON.VAR'
6933 include 'COMMON.GEO'
6934 include 'COMMON.FFIELD'
6935 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6936 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6939 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6940 cd & ' jj=',jj,' kk=',kk
6941 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6942 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6943 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6946 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6947 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6950 call transpose2(aa1(1,1),aa1t(1,1))
6951 call transpose2(aa2(1,1),aa2t(1,1))
6954 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6955 & aa1tder(1,1,lll,kkk))
6956 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6957 & aa2tder(1,1,lll,kkk))
6961 C parallel orientation of the two CA-CA-CA frames.
6963 iti=itortyp(itype(i))
6967 itk1=itortyp(itype(k+1))
6968 itj=itortyp(itype(j))
6969 if (l.lt.nres-1) then
6970 itl1=itortyp(itype(l+1))
6974 C A1 kernel(j+1) A2T
6976 cd write (iout,'(3f10.5,5x,3f10.5)')
6977 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6979 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6980 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6981 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6982 C Following matrices are needed only for 6-th order cumulants
6983 IF (wcorr6.gt.0.0d0) THEN
6984 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6985 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6986 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6987 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6988 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6989 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6990 & ADtEAderx(1,1,1,1,1,1))
6992 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6993 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6994 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6995 & ADtEA1derx(1,1,1,1,1,1))
6997 C End 6-th order cumulants
7000 cd write (2,*) 'In calc_eello6'
7002 cd write (2,*) 'iii=',iii
7004 cd write (2,*) 'kkk=',kkk
7006 cd write (2,'(3(2f10.5),5x)')
7007 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7012 call transpose2(EUgder(1,1,k),auxmat(1,1))
7013 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7014 call transpose2(EUg(1,1,k),auxmat(1,1))
7015 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7016 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7020 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7021 & EAEAderx(1,1,lll,kkk,iii,1))
7025 C A1T kernel(i+1) A2
7026 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7027 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7028 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7029 C Following matrices are needed only for 6-th order cumulants
7030 IF (wcorr6.gt.0.0d0) THEN
7031 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7032 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7033 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7034 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7035 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7036 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7037 & ADtEAderx(1,1,1,1,1,2))
7038 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7039 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7040 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7041 & ADtEA1derx(1,1,1,1,1,2))
7043 C End 6-th order cumulants
7044 call transpose2(EUgder(1,1,l),auxmat(1,1))
7045 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7046 call transpose2(EUg(1,1,l),auxmat(1,1))
7047 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7048 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7052 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7053 & EAEAderx(1,1,lll,kkk,iii,2))
7058 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7059 C They are needed only when the fifth- or the sixth-order cumulants are
7061 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7062 call transpose2(AEA(1,1,1),auxmat(1,1))
7063 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7064 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7065 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7066 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7067 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7068 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7069 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7070 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7071 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7072 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7073 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7074 call transpose2(AEA(1,1,2),auxmat(1,1))
7075 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7076 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7077 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7078 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7079 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7080 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7081 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7082 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7083 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7084 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7085 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7086 C Calculate the Cartesian derivatives of the vectors.
7090 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7091 call matvec2(auxmat(1,1),b1(1,iti),
7092 & AEAb1derx(1,lll,kkk,iii,1,1))
7093 call matvec2(auxmat(1,1),Ub2(1,i),
7094 & AEAb2derx(1,lll,kkk,iii,1,1))
7095 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7096 & AEAb1derx(1,lll,kkk,iii,2,1))
7097 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7098 & AEAb2derx(1,lll,kkk,iii,2,1))
7099 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7100 call matvec2(auxmat(1,1),b1(1,itj),
7101 & AEAb1derx(1,lll,kkk,iii,1,2))
7102 call matvec2(auxmat(1,1),Ub2(1,j),
7103 & AEAb2derx(1,lll,kkk,iii,1,2))
7104 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7105 & AEAb1derx(1,lll,kkk,iii,2,2))
7106 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7107 & AEAb2derx(1,lll,kkk,iii,2,2))
7114 C Antiparallel orientation of the two CA-CA-CA frames.
7116 iti=itortyp(itype(i))
7120 itk1=itortyp(itype(k+1))
7121 itl=itortyp(itype(l))
7122 itj=itortyp(itype(j))
7123 if (j.lt.nres-1) then
7124 itj1=itortyp(itype(j+1))
7128 C A2 kernel(j-1)T A1T
7129 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7130 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7131 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7132 C Following matrices are needed only for 6-th order cumulants
7133 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7134 & j.eq.i+4 .and. l.eq.i+3)) THEN
7135 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7136 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7137 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7138 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7139 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7140 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7141 & ADtEAderx(1,1,1,1,1,1))
7142 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7143 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7144 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7145 & ADtEA1derx(1,1,1,1,1,1))
7147 C End 6-th order cumulants
7148 call transpose2(EUgder(1,1,k),auxmat(1,1))
7149 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7150 call transpose2(EUg(1,1,k),auxmat(1,1))
7151 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7152 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7156 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7157 & EAEAderx(1,1,lll,kkk,iii,1))
7161 C A2T kernel(i+1)T A1
7162 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7163 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7164 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7165 C Following matrices are needed only for 6-th order cumulants
7166 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7167 & j.eq.i+4 .and. l.eq.i+3)) THEN
7168 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7169 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7170 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7171 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7172 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7173 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7174 & ADtEAderx(1,1,1,1,1,2))
7175 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7176 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7177 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7178 & ADtEA1derx(1,1,1,1,1,2))
7180 C End 6-th order cumulants
7181 call transpose2(EUgder(1,1,j),auxmat(1,1))
7182 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7183 call transpose2(EUg(1,1,j),auxmat(1,1))
7184 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7185 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7189 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7190 & EAEAderx(1,1,lll,kkk,iii,2))
7195 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7196 C They are needed only when the fifth- or the sixth-order cumulants are
7198 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7199 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7200 call transpose2(AEA(1,1,1),auxmat(1,1))
7201 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7202 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7203 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7204 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7205 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7206 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7207 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7208 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7209 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7210 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7211 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7212 call transpose2(AEA(1,1,2),auxmat(1,1))
7213 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7214 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7215 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7216 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7217 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7218 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7219 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7220 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7221 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7222 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7223 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7224 C Calculate the Cartesian derivatives of the vectors.
7228 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7229 call matvec2(auxmat(1,1),b1(1,iti),
7230 & AEAb1derx(1,lll,kkk,iii,1,1))
7231 call matvec2(auxmat(1,1),Ub2(1,i),
7232 & AEAb2derx(1,lll,kkk,iii,1,1))
7233 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7234 & AEAb1derx(1,lll,kkk,iii,2,1))
7235 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7236 & AEAb2derx(1,lll,kkk,iii,2,1))
7237 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7238 call matvec2(auxmat(1,1),b1(1,itl),
7239 & AEAb1derx(1,lll,kkk,iii,1,2))
7240 call matvec2(auxmat(1,1),Ub2(1,l),
7241 & AEAb2derx(1,lll,kkk,iii,1,2))
7242 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7243 & AEAb1derx(1,lll,kkk,iii,2,2))
7244 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7245 & AEAb2derx(1,lll,kkk,iii,2,2))
7254 C---------------------------------------------------------------------------
7255 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7256 & KK,KKderg,AKA,AKAderg,AKAderx)
7260 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7261 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7262 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7267 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7269 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7272 cd if (lprn) write (2,*) 'In kernel'
7274 cd if (lprn) write (2,*) 'kkk=',kkk
7276 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7277 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7279 cd write (2,*) 'lll=',lll
7280 cd write (2,*) 'iii=1'
7282 cd write (2,'(3(2f10.5),5x)')
7283 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7286 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7287 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7289 cd write (2,*) 'lll=',lll
7290 cd write (2,*) 'iii=2'
7292 cd write (2,'(3(2f10.5),5x)')
7293 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7300 C---------------------------------------------------------------------------
7301 double precision function eello4(i,j,k,l,jj,kk)
7302 implicit real*8 (a-h,o-z)
7303 include 'DIMENSIONS'
7304 include 'COMMON.IOUNITS'
7305 include 'COMMON.CHAIN'
7306 include 'COMMON.DERIV'
7307 include 'COMMON.INTERACT'
7308 include 'COMMON.CONTACTS'
7309 include 'COMMON.TORSION'
7310 include 'COMMON.VAR'
7311 include 'COMMON.GEO'
7312 double precision pizda(2,2),ggg1(3),ggg2(3)
7313 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7317 cd print *,'eello4:',i,j,k,l,jj,kk
7318 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7319 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7320 cold eij=facont_hb(jj,i)
7321 cold ekl=facont_hb(kk,k)
7323 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7324 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7325 gcorr_loc(k-1)=gcorr_loc(k-1)
7326 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7328 gcorr_loc(l-1)=gcorr_loc(l-1)
7329 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7331 gcorr_loc(j-1)=gcorr_loc(j-1)
7332 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7337 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7338 & -EAEAderx(2,2,lll,kkk,iii,1)
7339 cd derx(lll,kkk,iii)=0.0d0
7343 cd gcorr_loc(l-1)=0.0d0
7344 cd gcorr_loc(j-1)=0.0d0
7345 cd gcorr_loc(k-1)=0.0d0
7347 cd write (iout,*)'Contacts have occurred for peptide groups',
7348 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7349 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7350 if (j.lt.nres-1) then
7357 if (l.lt.nres-1) then
7365 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7366 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7367 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7368 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7369 cgrad ghalf=0.5d0*ggg1(ll)
7370 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7371 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7372 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7373 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7374 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7375 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7376 cgrad ghalf=0.5d0*ggg2(ll)
7377 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7378 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7379 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7380 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7381 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7382 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7386 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7391 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7396 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7401 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7405 cd write (2,*) iii,gcorr_loc(iii)
7408 cd write (2,*) 'ekont',ekont
7409 cd write (iout,*) 'eello4',ekont*eel4
7412 C---------------------------------------------------------------------------
7413 double precision function eello5(i,j,k,l,jj,kk)
7414 implicit real*8 (a-h,o-z)
7415 include 'DIMENSIONS'
7416 include 'COMMON.IOUNITS'
7417 include 'COMMON.CHAIN'
7418 include 'COMMON.DERIV'
7419 include 'COMMON.INTERACT'
7420 include 'COMMON.CONTACTS'
7421 include 'COMMON.TORSION'
7422 include 'COMMON.VAR'
7423 include 'COMMON.GEO'
7424 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7425 double precision ggg1(3),ggg2(3)
7426 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7431 C /l\ / \ \ / \ / \ / C
7432 C / \ / \ \ / \ / \ / C
7433 C j| o |l1 | o | o| o | | o |o C
7434 C \ |/k\| |/ \| / |/ \| |/ \| C
7435 C \i/ \ / \ / / \ / \ C
7437 C (I) (II) (III) (IV) C
7439 C eello5_1 eello5_2 eello5_3 eello5_4 C
7441 C Antiparallel chains C
7444 C /j\ / \ \ / \ / \ / C
7445 C / \ / \ \ / \ / \ / C
7446 C j1| o |l | o | o| o | | o |o C
7447 C \ |/k\| |/ \| / |/ \| |/ \| C
7448 C \i/ \ / \ / / \ / \ C
7450 C (I) (II) (III) (IV) C
7452 C eello5_1 eello5_2 eello5_3 eello5_4 C
7454 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7456 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7457 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7462 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7464 itk=itortyp(itype(k))
7465 itl=itortyp(itype(l))
7466 itj=itortyp(itype(j))
7471 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7472 cd & eel5_3_num,eel5_4_num)
7476 derx(lll,kkk,iii)=0.0d0
7480 cd eij=facont_hb(jj,i)
7481 cd ekl=facont_hb(kk,k)
7483 cd write (iout,*)'Contacts have occurred for peptide groups',
7484 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7486 C Contribution from the graph I.
7487 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7488 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7489 call transpose2(EUg(1,1,k),auxmat(1,1))
7490 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7491 vv(1)=pizda(1,1)-pizda(2,2)
7492 vv(2)=pizda(1,2)+pizda(2,1)
7493 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7494 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7495 C Explicit gradient in virtual-dihedral angles.
7496 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7497 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7498 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7499 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7500 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7501 vv(1)=pizda(1,1)-pizda(2,2)
7502 vv(2)=pizda(1,2)+pizda(2,1)
7503 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7504 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7505 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7506 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7507 vv(1)=pizda(1,1)-pizda(2,2)
7508 vv(2)=pizda(1,2)+pizda(2,1)
7510 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7511 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7512 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7514 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7515 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7516 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7518 C Cartesian gradient
7522 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7524 vv(1)=pizda(1,1)-pizda(2,2)
7525 vv(2)=pizda(1,2)+pizda(2,1)
7526 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7527 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7528 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7534 C Contribution from graph II
7535 call transpose2(EE(1,1,itk),auxmat(1,1))
7536 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7537 vv(1)=pizda(1,1)+pizda(2,2)
7538 vv(2)=pizda(2,1)-pizda(1,2)
7539 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7540 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7541 C Explicit gradient in virtual-dihedral angles.
7542 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7543 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7544 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7545 vv(1)=pizda(1,1)+pizda(2,2)
7546 vv(2)=pizda(2,1)-pizda(1,2)
7548 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7549 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7550 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7552 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7553 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7554 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7556 C Cartesian gradient
7560 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7562 vv(1)=pizda(1,1)+pizda(2,2)
7563 vv(2)=pizda(2,1)-pizda(1,2)
7564 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7565 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7566 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7574 C Parallel orientation
7575 C Contribution from graph III
7576 call transpose2(EUg(1,1,l),auxmat(1,1))
7577 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7578 vv(1)=pizda(1,1)-pizda(2,2)
7579 vv(2)=pizda(1,2)+pizda(2,1)
7580 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7581 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7582 C Explicit gradient in virtual-dihedral angles.
7583 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7584 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7585 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7586 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7587 vv(1)=pizda(1,1)-pizda(2,2)
7588 vv(2)=pizda(1,2)+pizda(2,1)
7589 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7590 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7591 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7592 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7593 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7594 vv(1)=pizda(1,1)-pizda(2,2)
7595 vv(2)=pizda(1,2)+pizda(2,1)
7596 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7597 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7598 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7599 C Cartesian gradient
7603 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7605 vv(1)=pizda(1,1)-pizda(2,2)
7606 vv(2)=pizda(1,2)+pizda(2,1)
7607 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7608 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7609 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7614 C Contribution from graph IV
7616 call transpose2(EE(1,1,itl),auxmat(1,1))
7617 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7618 vv(1)=pizda(1,1)+pizda(2,2)
7619 vv(2)=pizda(2,1)-pizda(1,2)
7620 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7621 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7622 C Explicit gradient in virtual-dihedral angles.
7623 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7624 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7625 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7626 vv(1)=pizda(1,1)+pizda(2,2)
7627 vv(2)=pizda(2,1)-pizda(1,2)
7628 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7629 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7630 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7631 C Cartesian gradient
7635 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7637 vv(1)=pizda(1,1)+pizda(2,2)
7638 vv(2)=pizda(2,1)-pizda(1,2)
7639 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7640 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7641 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7646 C Antiparallel orientation
7647 C Contribution from graph III
7649 call transpose2(EUg(1,1,j),auxmat(1,1))
7650 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7651 vv(1)=pizda(1,1)-pizda(2,2)
7652 vv(2)=pizda(1,2)+pizda(2,1)
7653 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7654 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7655 C Explicit gradient in virtual-dihedral angles.
7656 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7657 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7658 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7659 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7660 vv(1)=pizda(1,1)-pizda(2,2)
7661 vv(2)=pizda(1,2)+pizda(2,1)
7662 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7663 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7664 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7665 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7666 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7667 vv(1)=pizda(1,1)-pizda(2,2)
7668 vv(2)=pizda(1,2)+pizda(2,1)
7669 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7670 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7671 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7672 C Cartesian gradient
7676 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7678 vv(1)=pizda(1,1)-pizda(2,2)
7679 vv(2)=pizda(1,2)+pizda(2,1)
7680 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7681 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7682 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7687 C Contribution from graph IV
7689 call transpose2(EE(1,1,itj),auxmat(1,1))
7690 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7691 vv(1)=pizda(1,1)+pizda(2,2)
7692 vv(2)=pizda(2,1)-pizda(1,2)
7693 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7694 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7695 C Explicit gradient in virtual-dihedral angles.
7696 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7697 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7698 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7699 vv(1)=pizda(1,1)+pizda(2,2)
7700 vv(2)=pizda(2,1)-pizda(1,2)
7701 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7702 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7703 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7704 C Cartesian gradient
7708 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7710 vv(1)=pizda(1,1)+pizda(2,2)
7711 vv(2)=pizda(2,1)-pizda(1,2)
7712 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7713 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7714 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7720 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7721 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7722 cd write (2,*) 'ijkl',i,j,k,l
7723 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7724 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7726 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7727 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7728 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7729 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7730 if (j.lt.nres-1) then
7737 if (l.lt.nres-1) then
7747 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7748 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7749 C summed up outside the subrouine as for the other subroutines
7750 C handling long-range interactions. The old code is commented out
7751 C with "cgrad" to keep track of changes.
7753 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7754 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7755 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7756 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7757 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7758 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7759 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7760 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7761 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7762 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7764 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7765 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7766 cgrad ghalf=0.5d0*ggg1(ll)
7768 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7769 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7770 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7771 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7772 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7773 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7774 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7775 cgrad ghalf=0.5d0*ggg2(ll)
7777 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
7778 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7779 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
7780 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7781 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7782 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7787 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7788 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7793 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7794 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7800 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7805 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7809 cd write (2,*) iii,g_corr5_loc(iii)
7812 cd write (2,*) 'ekont',ekont
7813 cd write (iout,*) 'eello5',ekont*eel5
7816 c--------------------------------------------------------------------------
7817 double precision function eello6(i,j,k,l,jj,kk)
7818 implicit real*8 (a-h,o-z)
7819 include 'DIMENSIONS'
7820 include 'COMMON.IOUNITS'
7821 include 'COMMON.CHAIN'
7822 include 'COMMON.DERIV'
7823 include 'COMMON.INTERACT'
7824 include 'COMMON.CONTACTS'
7825 include 'COMMON.TORSION'
7826 include 'COMMON.VAR'
7827 include 'COMMON.GEO'
7828 include 'COMMON.FFIELD'
7829 double precision ggg1(3),ggg2(3)
7830 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7835 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7843 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7844 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7848 derx(lll,kkk,iii)=0.0d0
7852 cd eij=facont_hb(jj,i)
7853 cd ekl=facont_hb(kk,k)
7859 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7860 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7861 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7862 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7863 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7864 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7866 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7867 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7868 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7869 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7870 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7871 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7875 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7877 C If turn contributions are considered, they will be handled separately.
7878 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7879 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7880 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7881 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7882 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7883 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7884 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7886 if (j.lt.nres-1) then
7893 if (l.lt.nres-1) then
7901 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7902 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7903 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7904 cgrad ghalf=0.5d0*ggg1(ll)
7906 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7907 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7908 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7909 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7910 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7911 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7912 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7913 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7914 cgrad ghalf=0.5d0*ggg2(ll)
7915 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7917 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7918 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7919 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7920 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7921 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7922 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7927 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7928 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7933 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7934 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7940 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7945 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7949 cd write (2,*) iii,g_corr6_loc(iii)
7952 cd write (2,*) 'ekont',ekont
7953 cd write (iout,*) 'eello6',ekont*eel6
7956 c--------------------------------------------------------------------------
7957 double precision function eello6_graph1(i,j,k,l,imat,swap)
7958 implicit real*8 (a-h,o-z)
7959 include 'DIMENSIONS'
7960 include 'COMMON.IOUNITS'
7961 include 'COMMON.CHAIN'
7962 include 'COMMON.DERIV'
7963 include 'COMMON.INTERACT'
7964 include 'COMMON.CONTACTS'
7965 include 'COMMON.TORSION'
7966 include 'COMMON.VAR'
7967 include 'COMMON.GEO'
7968 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7972 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7974 C Parallel Antiparallel C
7980 C \ j|/k\| / \ |/k\|l / C
7985 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7986 itk=itortyp(itype(k))
7987 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7988 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7989 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7990 call transpose2(EUgC(1,1,k),auxmat(1,1))
7991 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7992 vv1(1)=pizda1(1,1)-pizda1(2,2)
7993 vv1(2)=pizda1(1,2)+pizda1(2,1)
7994 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7995 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7996 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7997 s5=scalar2(vv(1),Dtobr2(1,i))
7998 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7999 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8000 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8001 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8002 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8003 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8004 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8005 & +scalar2(vv(1),Dtobr2der(1,i)))
8006 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8007 vv1(1)=pizda1(1,1)-pizda1(2,2)
8008 vv1(2)=pizda1(1,2)+pizda1(2,1)
8009 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8010 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8012 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8013 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8014 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8015 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8016 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8018 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8019 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8020 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8021 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8022 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8024 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8025 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8026 vv1(1)=pizda1(1,1)-pizda1(2,2)
8027 vv1(2)=pizda1(1,2)+pizda1(2,1)
8028 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8029 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8030 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8031 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8040 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8041 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8042 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8043 call transpose2(EUgC(1,1,k),auxmat(1,1))
8044 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8046 vv1(1)=pizda1(1,1)-pizda1(2,2)
8047 vv1(2)=pizda1(1,2)+pizda1(2,1)
8048 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8049 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8050 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8051 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8052 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8053 s5=scalar2(vv(1),Dtobr2(1,i))
8054 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8060 c----------------------------------------------------------------------------
8061 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8062 implicit real*8 (a-h,o-z)
8063 include 'DIMENSIONS'
8064 include 'COMMON.IOUNITS'
8065 include 'COMMON.CHAIN'
8066 include 'COMMON.DERIV'
8067 include 'COMMON.INTERACT'
8068 include 'COMMON.CONTACTS'
8069 include 'COMMON.TORSION'
8070 include 'COMMON.VAR'
8071 include 'COMMON.GEO'
8073 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8074 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8077 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8079 C Parallel Antiparallel C
8085 C \ j|/k\| \ |/k\|l C
8090 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8091 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8092 C AL 7/4/01 s1 would occur in the sixth-order moment,
8093 C but not in a cluster cumulant
8095 s1=dip(1,jj,i)*dip(1,kk,k)
8097 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8098 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8099 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8100 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8101 call transpose2(EUg(1,1,k),auxmat(1,1))
8102 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8103 vv(1)=pizda(1,1)-pizda(2,2)
8104 vv(2)=pizda(1,2)+pizda(2,1)
8105 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8106 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8108 eello6_graph2=-(s1+s2+s3+s4)
8110 eello6_graph2=-(s2+s3+s4)
8113 C Derivatives in gamma(i-1)
8116 s1=dipderg(1,jj,i)*dip(1,kk,k)
8118 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8119 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8120 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8121 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8123 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8125 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8127 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8129 C Derivatives in gamma(k-1)
8131 s1=dip(1,jj,i)*dipderg(1,kk,k)
8133 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8134 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8135 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8136 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8137 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8138 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8139 vv(1)=pizda(1,1)-pizda(2,2)
8140 vv(2)=pizda(1,2)+pizda(2,1)
8141 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8143 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8145 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8147 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8148 C Derivatives in gamma(j-1) or gamma(l-1)
8151 s1=dipderg(3,jj,i)*dip(1,kk,k)
8153 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8154 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8155 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8156 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8157 vv(1)=pizda(1,1)-pizda(2,2)
8158 vv(2)=pizda(1,2)+pizda(2,1)
8159 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8162 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8164 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8167 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8168 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8170 C Derivatives in gamma(l-1) or gamma(j-1)
8173 s1=dip(1,jj,i)*dipderg(3,kk,k)
8175 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8176 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8177 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8178 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8179 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8180 vv(1)=pizda(1,1)-pizda(2,2)
8181 vv(2)=pizda(1,2)+pizda(2,1)
8182 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8185 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8187 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8190 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8191 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8193 C Cartesian derivatives.
8195 write (2,*) 'In eello6_graph2'
8197 write (2,*) 'iii=',iii
8199 write (2,*) 'kkk=',kkk
8201 write (2,'(3(2f10.5),5x)')
8202 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8212 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8214 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8217 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8219 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8220 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8222 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8223 call transpose2(EUg(1,1,k),auxmat(1,1))
8224 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8226 vv(1)=pizda(1,1)-pizda(2,2)
8227 vv(2)=pizda(1,2)+pizda(2,1)
8228 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8229 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8231 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8233 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8236 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8238 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8245 c----------------------------------------------------------------------------
8246 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8247 implicit real*8 (a-h,o-z)
8248 include 'DIMENSIONS'
8249 include 'COMMON.IOUNITS'
8250 include 'COMMON.CHAIN'
8251 include 'COMMON.DERIV'
8252 include 'COMMON.INTERACT'
8253 include 'COMMON.CONTACTS'
8254 include 'COMMON.TORSION'
8255 include 'COMMON.VAR'
8256 include 'COMMON.GEO'
8257 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8259 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8261 C Parallel Antiparallel C
8267 C j|/k\| / |/k\|l / C
8272 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8274 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8275 C energy moment and not to the cluster cumulant.
8276 iti=itortyp(itype(i))
8277 if (j.lt.nres-1) then
8278 itj1=itortyp(itype(j+1))
8282 itk=itortyp(itype(k))
8283 itk1=itortyp(itype(k+1))
8284 if (l.lt.nres-1) then
8285 itl1=itortyp(itype(l+1))
8290 s1=dip(4,jj,i)*dip(4,kk,k)
8292 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8293 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8294 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8295 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8296 call transpose2(EE(1,1,itk),auxmat(1,1))
8297 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8298 vv(1)=pizda(1,1)+pizda(2,2)
8299 vv(2)=pizda(2,1)-pizda(1,2)
8300 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8301 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8302 cd & "sum",-(s2+s3+s4)
8304 eello6_graph3=-(s1+s2+s3+s4)
8306 eello6_graph3=-(s2+s3+s4)
8309 C Derivatives in gamma(k-1)
8310 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8311 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8312 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8313 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8314 C Derivatives in gamma(l-1)
8315 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8316 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8317 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8318 vv(1)=pizda(1,1)+pizda(2,2)
8319 vv(2)=pizda(2,1)-pizda(1,2)
8320 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8321 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8322 C Cartesian derivatives.
8328 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8330 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8333 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8335 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8336 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8338 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8339 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8341 vv(1)=pizda(1,1)+pizda(2,2)
8342 vv(2)=pizda(2,1)-pizda(1,2)
8343 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8345 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8347 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8350 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8352 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8354 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8360 c----------------------------------------------------------------------------
8361 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8362 implicit real*8 (a-h,o-z)
8363 include 'DIMENSIONS'
8364 include 'COMMON.IOUNITS'
8365 include 'COMMON.CHAIN'
8366 include 'COMMON.DERIV'
8367 include 'COMMON.INTERACT'
8368 include 'COMMON.CONTACTS'
8369 include 'COMMON.TORSION'
8370 include 'COMMON.VAR'
8371 include 'COMMON.GEO'
8372 include 'COMMON.FFIELD'
8373 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8374 & auxvec1(2),auxmat1(2,2)
8376 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8378 C Parallel Antiparallel C
8384 C \ j|/k\| \ |/k\|l C
8389 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8391 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8392 C energy moment and not to the cluster cumulant.
8393 cd write (2,*) 'eello_graph4: wturn6',wturn6
8394 iti=itortyp(itype(i))
8395 itj=itortyp(itype(j))
8396 if (j.lt.nres-1) then
8397 itj1=itortyp(itype(j+1))
8401 itk=itortyp(itype(k))
8402 if (k.lt.nres-1) then
8403 itk1=itortyp(itype(k+1))
8407 itl=itortyp(itype(l))
8408 if (l.lt.nres-1) then
8409 itl1=itortyp(itype(l+1))
8413 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8414 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8415 cd & ' itl',itl,' itl1',itl1
8418 s1=dip(3,jj,i)*dip(3,kk,k)
8420 s1=dip(2,jj,j)*dip(2,kk,l)
8423 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8424 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8426 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8427 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8429 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8430 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8432 call transpose2(EUg(1,1,k),auxmat(1,1))
8433 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8434 vv(1)=pizda(1,1)-pizda(2,2)
8435 vv(2)=pizda(2,1)+pizda(1,2)
8436 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8437 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8439 eello6_graph4=-(s1+s2+s3+s4)
8441 eello6_graph4=-(s2+s3+s4)
8443 C Derivatives in gamma(i-1)
8447 s1=dipderg(2,jj,i)*dip(3,kk,k)
8449 s1=dipderg(4,jj,j)*dip(2,kk,l)
8452 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8454 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8455 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8457 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8458 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8460 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8461 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8462 cd write (2,*) 'turn6 derivatives'
8464 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8466 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8470 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8472 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8476 C Derivatives in gamma(k-1)
8479 s1=dip(3,jj,i)*dipderg(2,kk,k)
8481 s1=dip(2,jj,j)*dipderg(4,kk,l)
8484 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8485 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8487 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8488 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8490 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8491 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8493 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8494 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8495 vv(1)=pizda(1,1)-pizda(2,2)
8496 vv(2)=pizda(2,1)+pizda(1,2)
8497 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8498 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8500 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8502 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8506 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8508 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8511 C Derivatives in gamma(j-1) or gamma(l-1)
8512 if (l.eq.j+1 .and. l.gt.1) then
8513 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8514 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8515 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8516 vv(1)=pizda(1,1)-pizda(2,2)
8517 vv(2)=pizda(2,1)+pizda(1,2)
8518 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8519 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8520 else if (j.gt.1) then
8521 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8522 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8523 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8524 vv(1)=pizda(1,1)-pizda(2,2)
8525 vv(2)=pizda(2,1)+pizda(1,2)
8526 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8527 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8528 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8530 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8533 C Cartesian derivatives.
8540 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8542 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8546 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8548 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8552 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8554 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8556 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8557 & b1(1,itj1),auxvec(1))
8558 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8560 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8561 & b1(1,itl1),auxvec(1))
8562 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8564 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8566 vv(1)=pizda(1,1)-pizda(2,2)
8567 vv(2)=pizda(2,1)+pizda(1,2)
8568 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8570 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8572 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8575 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8578 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8581 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8583 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8585 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8589 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8591 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8594 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8596 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8604 c----------------------------------------------------------------------------
8605 double precision function eello_turn6(i,jj,kk)
8606 implicit real*8 (a-h,o-z)
8607 include 'DIMENSIONS'
8608 include 'COMMON.IOUNITS'
8609 include 'COMMON.CHAIN'
8610 include 'COMMON.DERIV'
8611 include 'COMMON.INTERACT'
8612 include 'COMMON.CONTACTS'
8613 include 'COMMON.TORSION'
8614 include 'COMMON.VAR'
8615 include 'COMMON.GEO'
8616 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8617 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8619 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8620 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8621 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8622 C the respective energy moment and not to the cluster cumulant.
8631 iti=itortyp(itype(i))
8632 itk=itortyp(itype(k))
8633 itk1=itortyp(itype(k+1))
8634 itl=itortyp(itype(l))
8635 itj=itortyp(itype(j))
8636 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8637 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8638 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8643 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8645 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8649 derx_turn(lll,kkk,iii)=0.0d0
8656 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8658 cd write (2,*) 'eello6_5',eello6_5
8660 call transpose2(AEA(1,1,1),auxmat(1,1))
8661 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8662 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8663 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8665 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8666 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8667 s2 = scalar2(b1(1,itk),vtemp1(1))
8669 call transpose2(AEA(1,1,2),atemp(1,1))
8670 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8671 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8672 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8674 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8675 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8676 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8678 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8679 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8680 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8681 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8682 ss13 = scalar2(b1(1,itk),vtemp4(1))
8683 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8685 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8691 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8692 C Derivatives in gamma(i+2)
8696 call transpose2(AEA(1,1,1),auxmatd(1,1))
8697 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8698 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8699 call transpose2(AEAderg(1,1,2),atempd(1,1))
8700 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8701 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8703 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8704 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8705 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8711 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8712 C Derivatives in gamma(i+3)
8714 call transpose2(AEA(1,1,1),auxmatd(1,1))
8715 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8716 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8717 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8719 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8720 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8721 s2d = scalar2(b1(1,itk),vtemp1d(1))
8723 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8724 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8726 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8728 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8729 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8730 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8738 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8739 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8741 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8742 & -0.5d0*ekont*(s2d+s12d)
8744 C Derivatives in gamma(i+4)
8745 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8746 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8747 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8749 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8750 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8751 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8759 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8761 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8763 C Derivatives in gamma(i+5)
8765 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8766 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8767 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8769 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8770 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8771 s2d = scalar2(b1(1,itk),vtemp1d(1))
8773 call transpose2(AEA(1,1,2),atempd(1,1))
8774 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8775 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8777 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8778 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8780 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8781 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8782 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8790 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8791 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8793 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8794 & -0.5d0*ekont*(s2d+s12d)
8796 C Cartesian derivatives
8801 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8802 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8803 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8805 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8806 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8808 s2d = scalar2(b1(1,itk),vtemp1d(1))
8810 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8811 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8812 s8d = -(atempd(1,1)+atempd(2,2))*
8813 & scalar2(cc(1,1,itl),vtemp2(1))
8815 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8817 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8818 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8825 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8828 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8832 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8833 & - 0.5d0*(s8d+s12d)
8835 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8844 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8846 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8847 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8848 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8849 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8850 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8852 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8853 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8854 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8858 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8859 cd & 16*eel_turn6_num
8861 if (j.lt.nres-1) then
8868 if (l.lt.nres-1) then
8876 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8877 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8878 cgrad ghalf=0.5d0*ggg1(ll)
8880 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8881 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8882 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8883 & +ekont*derx_turn(ll,2,1)
8884 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8885 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8886 & +ekont*derx_turn(ll,4,1)
8887 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8888 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8889 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8890 cgrad ghalf=0.5d0*ggg2(ll)
8892 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8893 & +ekont*derx_turn(ll,2,2)
8894 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8895 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8896 & +ekont*derx_turn(ll,4,2)
8897 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8898 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8899 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8904 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8909 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8915 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8920 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8924 cd write (2,*) iii,g_corr6_loc(iii)
8926 eello_turn6=ekont*eel_turn6
8927 cd write (2,*) 'ekont',ekont
8928 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8932 C-----------------------------------------------------------------------------
8933 double precision function scalar(u,v)
8934 !DIR$ INLINEALWAYS scalar
8936 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8939 double precision u(3),v(3)
8940 cd double precision sc
8948 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8951 crc-------------------------------------------------
8952 SUBROUTINE MATVEC2(A1,V1,V2)
8953 !DIR$ INLINEALWAYS MATVEC2
8955 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8957 implicit real*8 (a-h,o-z)
8958 include 'DIMENSIONS'
8959 DIMENSION A1(2,2),V1(2),V2(2)
8963 c 3 VI=VI+A1(I,K)*V1(K)
8967 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8968 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8973 C---------------------------------------
8974 SUBROUTINE MATMAT2(A1,A2,A3)
8976 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8978 implicit real*8 (a-h,o-z)
8979 include 'DIMENSIONS'
8980 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8981 c DIMENSION AI3(2,2)
8985 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8991 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8992 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8993 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8994 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9002 c-------------------------------------------------------------------------
9003 double precision function scalar2(u,v)
9004 !DIR$ INLINEALWAYS scalar2
9006 double precision u(2),v(2)
9009 scalar2=u(1)*v(1)+u(2)*v(2)
9013 C-----------------------------------------------------------------------------
9015 subroutine transpose2(a,at)
9016 !DIR$ INLINEALWAYS transpose2
9018 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9021 double precision a(2,2),at(2,2)
9028 c--------------------------------------------------------------------------
9029 subroutine transpose(n,a,at)
9032 double precision a(n,n),at(n,n)
9040 C---------------------------------------------------------------------------
9041 subroutine prodmat3(a1,a2,kk,transp,prod)
9042 !DIR$ INLINEALWAYS prodmat3
9044 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9048 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9050 crc double precision auxmat(2,2),prod_(2,2)
9053 crc call transpose2(kk(1,1),auxmat(1,1))
9054 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9055 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9057 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9058 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9059 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9060 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9061 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9062 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9063 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9064 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9067 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9068 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9070 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9071 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9072 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9073 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9074 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9075 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9076 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9077 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9080 c call transpose2(a2(1,1),a2t(1,1))
9083 crc print *,((prod_(i,j),i=1,2),j=1,2)
9084 crc print *,((prod(i,j),i=1,2),j=1,2)