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 ccccc energy_dec=.false.
1425 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1428 c if (icall.eq.0) lprn=.false.
1430 do i=iatsc_s,iatsc_e
1431 itypi=iabs(itype(i))
1432 if (itypi.eq.ntyp1) cycle
1433 itypi1=iabs(itype(i+1))
1437 dxi=dc_norm(1,nres+i)
1438 dyi=dc_norm(2,nres+i)
1439 dzi=dc_norm(3,nres+i)
1440 c dsci_inv=dsc_inv(itypi)
1441 dsci_inv=vbld_inv(i+nres)
1442 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1443 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1445 C Calculate SC interaction energy.
1447 do iint=1,nint_gr(i)
1448 do j=istart(i,iint),iend(i,iint)
1449 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1450 call dyn_ssbond_ene(i,j,evdwij)
1452 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1453 & 'evdw',i,j,evdwij,' ss'
1454 C triple bond artifac removal
1455 do k=j+1,iend(i,iint)
1456 C search over all next residues
1457 if (dyn_ss_mask(k)) then
1458 C check if they are cysteins
1459 C write(iout,*) 'k=',k
1460 call triple_ssbond_ene(i,j,k,evdwij)
1461 C call the energy function that removes the artifical triple disulfide
1462 C bond the soubroutine is located in ssMD.F
1464 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1465 & 'evdw',i,j,evdwij,'tss'
1466 endif!dyn_ss_mask(k)
1470 itypj=iabs(itype(j))
1471 if (itypj.eq.ntyp1) cycle
1472 c dscj_inv=dsc_inv(itypj)
1473 dscj_inv=vbld_inv(j+nres)
1474 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1475 c & 1.0d0/vbld(j+nres)
1476 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1477 sig0ij=sigma(itypi,itypj)
1478 chi1=chi(itypi,itypj)
1479 chi2=chi(itypj,itypi)
1486 alf12=0.5D0*(alf1+alf2)
1487 C For diagnostics only!!!
1500 dxj=dc_norm(1,nres+j)
1501 dyj=dc_norm(2,nres+j)
1502 dzj=dc_norm(3,nres+j)
1503 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1504 c write (iout,*) "j",j," dc_norm",
1505 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1506 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1508 C Calculate angle-dependent terms of energy and contributions to their
1512 sig=sig0ij*dsqrt(sigsq)
1513 rij_shift=1.0D0/rij-sig+sig0ij
1514 c for diagnostics; uncomment
1515 c rij_shift=1.2*sig0ij
1516 C I hate to put IF's in the loops, but here don't have another choice!!!!
1517 if (rij_shift.le.0.0D0) then
1519 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1520 cd & restyp(itypi),i,restyp(itypj),j,
1521 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1525 c---------------------------------------------------------------
1526 rij_shift=1.0D0/rij_shift
1527 fac=rij_shift**expon
1528 e1=fac*fac*aa(itypi,itypj)
1529 e2=fac*bb(itypi,itypj)
1530 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1531 eps2der=evdwij*eps3rt
1532 eps3der=evdwij*eps2rt
1533 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1534 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1535 evdwij=evdwij*eps2rt*eps3rt
1538 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1539 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1540 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1541 & restyp(itypi),i,restyp(itypj),j,
1542 & epsi,sigm,chi1,chi2,chip1,chip2,
1543 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1544 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1548 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1551 C Calculate gradient components.
1552 e1=e1*eps1*eps2rt**2*eps3rt**2
1553 fac=-expon*(e1+evdwij)*rij_shift
1557 C Calculate the radial part of the gradient
1561 C Calculate angular part of the gradient.
1567 c write (iout,*) "Number of loop steps in EGB:",ind
1568 cccc energy_dec=.false.
1571 C-----------------------------------------------------------------------------
1572 subroutine egbv(evdw)
1574 C This subroutine calculates the interaction energy of nonbonded side chains
1575 C assuming the Gay-Berne-Vorobjev potential of interaction.
1577 implicit real*8 (a-h,o-z)
1578 include 'DIMENSIONS'
1579 include 'COMMON.GEO'
1580 include 'COMMON.VAR'
1581 include 'COMMON.LOCAL'
1582 include 'COMMON.CHAIN'
1583 include 'COMMON.DERIV'
1584 include 'COMMON.NAMES'
1585 include 'COMMON.INTERACT'
1586 include 'COMMON.IOUNITS'
1587 include 'COMMON.CALC'
1588 common /srutu/ icall
1591 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1594 c if (icall.eq.0) lprn=.true.
1596 do i=iatsc_s,iatsc_e
1597 itypi=iabs(itype(i))
1598 if (itypi.eq.ntyp1) cycle
1599 itypi1=iabs(itype(i+1))
1603 dxi=dc_norm(1,nres+i)
1604 dyi=dc_norm(2,nres+i)
1605 dzi=dc_norm(3,nres+i)
1606 c dsci_inv=dsc_inv(itypi)
1607 dsci_inv=vbld_inv(i+nres)
1609 C Calculate SC interaction energy.
1611 do iint=1,nint_gr(i)
1612 do j=istart(i,iint),iend(i,iint)
1614 itypj=iabs(itype(j))
1615 if (itypj.eq.ntyp1) cycle
1616 c dscj_inv=dsc_inv(itypj)
1617 dscj_inv=vbld_inv(j+nres)
1618 sig0ij=sigma(itypi,itypj)
1619 r0ij=r0(itypi,itypj)
1620 chi1=chi(itypi,itypj)
1621 chi2=chi(itypj,itypi)
1628 alf12=0.5D0*(alf1+alf2)
1629 C For diagnostics only!!!
1642 dxj=dc_norm(1,nres+j)
1643 dyj=dc_norm(2,nres+j)
1644 dzj=dc_norm(3,nres+j)
1645 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1647 C Calculate angle-dependent terms of energy and contributions to their
1651 sig=sig0ij*dsqrt(sigsq)
1652 rij_shift=1.0D0/rij-sig+r0ij
1653 C I hate to put IF's in the loops, but here don't have another choice!!!!
1654 if (rij_shift.le.0.0D0) then
1659 c---------------------------------------------------------------
1660 rij_shift=1.0D0/rij_shift
1661 fac=rij_shift**expon
1662 e1=fac*fac*aa(itypi,itypj)
1663 e2=fac*bb(itypi,itypj)
1664 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1665 eps2der=evdwij*eps3rt
1666 eps3der=evdwij*eps2rt
1667 fac_augm=rrij**expon
1668 e_augm=augm(itypi,itypj)*fac_augm
1669 evdwij=evdwij*eps2rt*eps3rt
1670 evdw=evdw+evdwij+e_augm
1672 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1673 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1674 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1675 & restyp(itypi),i,restyp(itypj),j,
1676 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1677 & chi1,chi2,chip1,chip2,
1678 & eps1,eps2rt**2,eps3rt**2,
1679 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1682 C Calculate gradient components.
1683 e1=e1*eps1*eps2rt**2*eps3rt**2
1684 fac=-expon*(e1+evdwij)*rij_shift
1686 fac=rij*fac-2*expon*rrij*e_augm
1687 C Calculate the radial part of the gradient
1691 C Calculate angular part of the gradient.
1697 C-----------------------------------------------------------------------------
1698 subroutine sc_angular
1699 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1700 C om12. Called by ebp, egb, and egbv.
1702 include 'COMMON.CALC'
1703 include 'COMMON.IOUNITS'
1707 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1708 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1709 om12=dxi*dxj+dyi*dyj+dzi*dzj
1711 C Calculate eps1(om12) and its derivative in om12
1712 faceps1=1.0D0-om12*chiom12
1713 faceps1_inv=1.0D0/faceps1
1714 eps1=dsqrt(faceps1_inv)
1715 C Following variable is eps1*deps1/dom12
1716 eps1_om12=faceps1_inv*chiom12
1721 c write (iout,*) "om12",om12," eps1",eps1
1722 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1727 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1728 sigsq=1.0D0-facsig*faceps1_inv
1729 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1730 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1731 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1737 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1738 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1740 C Calculate eps2 and its derivatives in om1, om2, and om12.
1743 chipom12=chip12*om12
1744 facp=1.0D0-om12*chipom12
1746 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1747 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1748 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1749 C Following variable is the square root of eps2
1750 eps2rt=1.0D0-facp1*facp_inv
1751 C Following three variables are the derivatives of the square root of eps
1752 C in om1, om2, and om12.
1753 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1754 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1755 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1756 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1757 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1758 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1759 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1760 c & " eps2rt_om12",eps2rt_om12
1761 C Calculate whole angle-dependent part of epsilon and contributions
1762 C to its derivatives
1765 C----------------------------------------------------------------------------
1767 implicit real*8 (a-h,o-z)
1768 include 'DIMENSIONS'
1769 include 'COMMON.CHAIN'
1770 include 'COMMON.DERIV'
1771 include 'COMMON.CALC'
1772 include 'COMMON.IOUNITS'
1773 double precision dcosom1(3),dcosom2(3)
1774 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1775 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1776 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1777 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1781 c eom12=evdwij*eps1_om12
1783 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1784 c & " sigder",sigder
1785 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1786 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1788 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1789 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1792 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1794 c write (iout,*) "gg",(gg(k),k=1,3)
1796 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1797 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1798 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1799 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1800 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1801 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1802 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1803 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1804 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1805 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1808 C Calculate the components of the gradient in DC and X
1812 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1816 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1817 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1821 C-----------------------------------------------------------------------
1822 subroutine e_softsphere(evdw)
1824 C This subroutine calculates the interaction energy of nonbonded side chains
1825 C assuming the LJ potential of interaction.
1827 implicit real*8 (a-h,o-z)
1828 include 'DIMENSIONS'
1829 parameter (accur=1.0d-10)
1830 include 'COMMON.GEO'
1831 include 'COMMON.VAR'
1832 include 'COMMON.LOCAL'
1833 include 'COMMON.CHAIN'
1834 include 'COMMON.DERIV'
1835 include 'COMMON.INTERACT'
1836 include 'COMMON.TORSION'
1837 include 'COMMON.SBRIDGE'
1838 include 'COMMON.NAMES'
1839 include 'COMMON.IOUNITS'
1840 include 'COMMON.CONTACTS'
1842 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1844 do i=iatsc_s,iatsc_e
1845 itypi=iabs(itype(i))
1846 if (itypi.eq.ntyp1) cycle
1847 itypi1=iabs(itype(i+1))
1852 C Calculate SC interaction energy.
1854 do iint=1,nint_gr(i)
1855 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1856 cd & 'iend=',iend(i,iint)
1857 do j=istart(i,iint),iend(i,iint)
1858 itypj=iabs(itype(j))
1859 if (itypj.eq.ntyp1) cycle
1863 rij=xj*xj+yj*yj+zj*zj
1864 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1865 r0ij=r0(itypi,itypj)
1867 c print *,i,j,r0ij,dsqrt(rij)
1868 if (rij.lt.r0ijsq) then
1869 evdwij=0.25d0*(rij-r0ijsq)**2
1877 C Calculate the components of the gradient in DC and X
1883 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1884 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1885 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1886 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1890 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1898 C--------------------------------------------------------------------------
1899 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1902 C Soft-sphere potential of p-p interaction
1904 implicit real*8 (a-h,o-z)
1905 include 'DIMENSIONS'
1906 include 'COMMON.CONTROL'
1907 include 'COMMON.IOUNITS'
1908 include 'COMMON.GEO'
1909 include 'COMMON.VAR'
1910 include 'COMMON.LOCAL'
1911 include 'COMMON.CHAIN'
1912 include 'COMMON.DERIV'
1913 include 'COMMON.INTERACT'
1914 include 'COMMON.CONTACTS'
1915 include 'COMMON.TORSION'
1916 include 'COMMON.VECTORS'
1917 include 'COMMON.FFIELD'
1919 cd write(iout,*) 'In EELEC_soft_sphere'
1926 do i=iatel_s,iatel_e
1927 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1931 xmedi=c(1,i)+0.5d0*dxi
1932 ymedi=c(2,i)+0.5d0*dyi
1933 zmedi=c(3,i)+0.5d0*dzi
1935 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1936 do j=ielstart(i),ielend(i)
1937 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1941 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1942 r0ij=rpp(iteli,itelj)
1947 xj=c(1,j)+0.5D0*dxj-xmedi
1948 yj=c(2,j)+0.5D0*dyj-ymedi
1949 zj=c(3,j)+0.5D0*dzj-zmedi
1950 rij=xj*xj+yj*yj+zj*zj
1951 if (rij.lt.r0ijsq) then
1952 evdw1ij=0.25d0*(rij-r0ijsq)**2
1960 C Calculate contributions to the Cartesian gradient.
1966 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1967 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1970 * Loop over residues i+1 thru j-1.
1974 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
1979 cgrad do i=nnt,nct-1
1981 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1983 cgrad do j=i+1,nct-1
1985 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
1991 c------------------------------------------------------------------------------
1992 subroutine vec_and_deriv
1993 implicit real*8 (a-h,o-z)
1994 include 'DIMENSIONS'
1998 include 'COMMON.IOUNITS'
1999 include 'COMMON.GEO'
2000 include 'COMMON.VAR'
2001 include 'COMMON.LOCAL'
2002 include 'COMMON.CHAIN'
2003 include 'COMMON.VECTORS'
2004 include 'COMMON.SETUP'
2005 include 'COMMON.TIME1'
2006 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2007 C Compute the local reference systems. For reference system (i), the
2008 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2009 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2011 do i=ivec_start,ivec_end
2015 if (i.eq.nres-1) then
2016 C Case of the last full residue
2017 C Compute the Z-axis
2018 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2019 costh=dcos(pi-theta(nres))
2020 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2024 C Compute the derivatives of uz
2026 uzder(2,1,1)=-dc_norm(3,i-1)
2027 uzder(3,1,1)= dc_norm(2,i-1)
2028 uzder(1,2,1)= dc_norm(3,i-1)
2030 uzder(3,2,1)=-dc_norm(1,i-1)
2031 uzder(1,3,1)=-dc_norm(2,i-1)
2032 uzder(2,3,1)= dc_norm(1,i-1)
2035 uzder(2,1,2)= dc_norm(3,i)
2036 uzder(3,1,2)=-dc_norm(2,i)
2037 uzder(1,2,2)=-dc_norm(3,i)
2039 uzder(3,2,2)= dc_norm(1,i)
2040 uzder(1,3,2)= dc_norm(2,i)
2041 uzder(2,3,2)=-dc_norm(1,i)
2043 C Compute the Y-axis
2046 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2048 C Compute the derivatives of uy
2051 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2052 & -dc_norm(k,i)*dc_norm(j,i-1)
2053 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2055 uyder(j,j,1)=uyder(j,j,1)-costh
2056 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2061 uygrad(l,k,j,i)=uyder(l,k,j)
2062 uzgrad(l,k,j,i)=uzder(l,k,j)
2066 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2067 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2068 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2069 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2072 C Compute the Z-axis
2073 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2074 costh=dcos(pi-theta(i+2))
2075 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2079 C Compute the derivatives of uz
2081 uzder(2,1,1)=-dc_norm(3,i+1)
2082 uzder(3,1,1)= dc_norm(2,i+1)
2083 uzder(1,2,1)= dc_norm(3,i+1)
2085 uzder(3,2,1)=-dc_norm(1,i+1)
2086 uzder(1,3,1)=-dc_norm(2,i+1)
2087 uzder(2,3,1)= dc_norm(1,i+1)
2090 uzder(2,1,2)= dc_norm(3,i)
2091 uzder(3,1,2)=-dc_norm(2,i)
2092 uzder(1,2,2)=-dc_norm(3,i)
2094 uzder(3,2,2)= dc_norm(1,i)
2095 uzder(1,3,2)= dc_norm(2,i)
2096 uzder(2,3,2)=-dc_norm(1,i)
2098 C Compute the Y-axis
2101 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2103 C Compute the derivatives of uy
2106 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2107 & -dc_norm(k,i)*dc_norm(j,i+1)
2108 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2110 uyder(j,j,1)=uyder(j,j,1)-costh
2111 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2116 uygrad(l,k,j,i)=uyder(l,k,j)
2117 uzgrad(l,k,j,i)=uzder(l,k,j)
2121 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2122 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2123 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2124 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2128 vbld_inv_temp(1)=vbld_inv(i+1)
2129 if (i.lt.nres-1) then
2130 vbld_inv_temp(2)=vbld_inv(i+2)
2132 vbld_inv_temp(2)=vbld_inv(i)
2137 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2138 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2143 #if defined(PARVEC) && defined(MPI)
2144 if (nfgtasks1.gt.1) then
2146 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2147 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2148 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2149 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2150 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2152 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2153 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2155 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2156 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2157 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2158 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2159 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2160 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2161 time_gather=time_gather+MPI_Wtime()-time00
2163 c if (fg_rank.eq.0) then
2164 c write (iout,*) "Arrays UY and UZ"
2166 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2173 C-----------------------------------------------------------------------------
2174 subroutine check_vecgrad
2175 implicit real*8 (a-h,o-z)
2176 include 'DIMENSIONS'
2177 include 'COMMON.IOUNITS'
2178 include 'COMMON.GEO'
2179 include 'COMMON.VAR'
2180 include 'COMMON.LOCAL'
2181 include 'COMMON.CHAIN'
2182 include 'COMMON.VECTORS'
2183 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2184 dimension uyt(3,maxres),uzt(3,maxres)
2185 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2186 double precision delta /1.0d-7/
2189 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2190 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2191 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2192 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2193 cd & (dc_norm(if90,i),if90=1,3)
2194 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2195 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2196 cd write(iout,'(a)')
2202 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2203 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2216 cd write (iout,*) 'i=',i
2218 erij(k)=dc_norm(k,i)
2222 dc_norm(k,i)=erij(k)
2224 dc_norm(j,i)=dc_norm(j,i)+delta
2225 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2227 c dc_norm(k,i)=dc_norm(k,i)/fac
2229 c write (iout,*) (dc_norm(k,i),k=1,3)
2230 c write (iout,*) (erij(k),k=1,3)
2233 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2234 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2235 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2236 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2238 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2239 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2240 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2243 dc_norm(k,i)=erij(k)
2246 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2247 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2248 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2249 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2250 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2251 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2252 cd write (iout,'(a)')
2257 C--------------------------------------------------------------------------
2258 subroutine set_matrices
2259 implicit real*8 (a-h,o-z)
2260 include 'DIMENSIONS'
2263 include "COMMON.SETUP"
2265 integer status(MPI_STATUS_SIZE)
2267 include 'COMMON.IOUNITS'
2268 include 'COMMON.GEO'
2269 include 'COMMON.VAR'
2270 include 'COMMON.LOCAL'
2271 include 'COMMON.CHAIN'
2272 include 'COMMON.DERIV'
2273 include 'COMMON.INTERACT'
2274 include 'COMMON.CONTACTS'
2275 include 'COMMON.TORSION'
2276 include 'COMMON.VECTORS'
2277 include 'COMMON.FFIELD'
2278 double precision auxvec(2),auxmat(2,2)
2280 C Compute the virtual-bond-torsional-angle dependent quantities needed
2281 C to calculate the el-loc multibody terms of various order.
2284 do i=ivec_start+2,ivec_end+2
2288 if (i .lt. nres+1) then
2325 if (i .gt. 3 .and. i .lt. nres+1) then
2326 obrot_der(1,i-2)=-sin1
2327 obrot_der(2,i-2)= cos1
2328 Ugder(1,1,i-2)= sin1
2329 Ugder(1,2,i-2)=-cos1
2330 Ugder(2,1,i-2)=-cos1
2331 Ugder(2,2,i-2)=-sin1
2334 obrot2_der(1,i-2)=-dwasin2
2335 obrot2_der(2,i-2)= dwacos2
2336 Ug2der(1,1,i-2)= dwasin2
2337 Ug2der(1,2,i-2)=-dwacos2
2338 Ug2der(2,1,i-2)=-dwacos2
2339 Ug2der(2,2,i-2)=-dwasin2
2341 obrot_der(1,i-2)=0.0d0
2342 obrot_der(2,i-2)=0.0d0
2343 Ugder(1,1,i-2)=0.0d0
2344 Ugder(1,2,i-2)=0.0d0
2345 Ugder(2,1,i-2)=0.0d0
2346 Ugder(2,2,i-2)=0.0d0
2347 obrot2_der(1,i-2)=0.0d0
2348 obrot2_der(2,i-2)=0.0d0
2349 Ug2der(1,1,i-2)=0.0d0
2350 Ug2der(1,2,i-2)=0.0d0
2351 Ug2der(2,1,i-2)=0.0d0
2352 Ug2der(2,2,i-2)=0.0d0
2354 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2355 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2356 iti = itortyp(itype(i-2))
2360 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2361 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2362 iti1 = itortyp(itype(i-1))
2366 cd write (iout,*) '*******i',i,' iti1',iti
2367 cd write (iout,*) 'b1',b1(:,iti)
2368 cd write (iout,*) 'b2',b2(:,iti)
2369 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2370 c if (i .gt. iatel_s+2) then
2371 if (i .gt. nnt+2) then
2372 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2373 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2374 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2376 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2377 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2378 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2379 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2380 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2391 DtUg2(l,k,i-2)=0.0d0
2395 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2396 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2398 muder(k,i-2)=Ub2der(k,i-2)
2400 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2401 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2402 if (itype(i-1).le.ntyp) then
2403 iti1 = itortyp(itype(i-1))
2411 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2413 cd write (iout,*) 'mu ',mu(:,i-2)
2414 cd write (iout,*) 'mu1',mu1(:,i-2)
2415 cd write (iout,*) 'mu2',mu2(:,i-2)
2416 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2418 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2419 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2420 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2421 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2422 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2423 C Vectors and matrices dependent on a single virtual-bond dihedral.
2424 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2425 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2426 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2427 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2428 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2429 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2430 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2431 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2432 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2435 C Matrices dependent on two consecutive virtual-bond dihedrals.
2436 C The order of matrices is from left to right.
2437 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2439 c do i=max0(ivec_start,2),ivec_end
2441 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2442 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2443 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2444 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2445 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2446 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2447 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2448 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2451 #if defined(MPI) && defined(PARMAT)
2453 c if (fg_rank.eq.0) then
2454 write (iout,*) "Arrays UG and UGDER before GATHER"
2456 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2457 & ((ug(l,k,i),l=1,2),k=1,2),
2458 & ((ugder(l,k,i),l=1,2),k=1,2)
2460 write (iout,*) "Arrays UG2 and UG2DER"
2462 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2463 & ((ug2(l,k,i),l=1,2),k=1,2),
2464 & ((ug2der(l,k,i),l=1,2),k=1,2)
2466 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2468 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2469 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2470 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2472 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2474 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2475 & costab(i),sintab(i),costab2(i),sintab2(i)
2477 write (iout,*) "Array MUDER"
2479 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2483 if (nfgtasks.gt.1) then
2485 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2486 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2487 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2489 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2490 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2492 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2493 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2495 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2496 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2498 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2499 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2501 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2502 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2504 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2505 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2507 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2508 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2509 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2510 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2511 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2512 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2513 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2514 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2515 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2516 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2517 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2518 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2519 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2521 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2522 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2524 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2525 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2527 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2528 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2530 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2531 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2533 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2534 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2536 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2537 & ivec_count(fg_rank1),
2538 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2540 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2541 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2543 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2544 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2546 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2547 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2549 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2550 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2552 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2553 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2555 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2556 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2558 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2559 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2561 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2562 & ivec_count(fg_rank1),
2563 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2565 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2566 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2568 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2569 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2571 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2572 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2574 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2575 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2577 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2578 & ivec_count(fg_rank1),
2579 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2581 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2582 & ivec_count(fg_rank1),
2583 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2585 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2586 & ivec_count(fg_rank1),
2587 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2588 & MPI_MAT2,FG_COMM1,IERR)
2589 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2590 & ivec_count(fg_rank1),
2591 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2592 & MPI_MAT2,FG_COMM1,IERR)
2595 c Passes matrix info through the ring
2598 if (irecv.lt.0) irecv=nfgtasks1-1
2601 if (inext.ge.nfgtasks1) inext=0
2603 c write (iout,*) "isend",isend," irecv",irecv
2605 lensend=lentyp(isend)
2606 lenrecv=lentyp(irecv)
2607 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2608 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2609 c & MPI_ROTAT1(lensend),inext,2200+isend,
2610 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2611 c & iprev,2200+irecv,FG_COMM,status,IERR)
2612 c write (iout,*) "Gather ROTAT1"
2614 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2615 c & MPI_ROTAT2(lensend),inext,3300+isend,
2616 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2617 c & iprev,3300+irecv,FG_COMM,status,IERR)
2618 c write (iout,*) "Gather ROTAT2"
2620 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2621 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2622 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2623 & iprev,4400+irecv,FG_COMM,status,IERR)
2624 c write (iout,*) "Gather ROTAT_OLD"
2626 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2627 & MPI_PRECOMP11(lensend),inext,5500+isend,
2628 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2629 & iprev,5500+irecv,FG_COMM,status,IERR)
2630 c write (iout,*) "Gather PRECOMP11"
2632 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2633 & MPI_PRECOMP12(lensend),inext,6600+isend,
2634 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2635 & iprev,6600+irecv,FG_COMM,status,IERR)
2636 c write (iout,*) "Gather PRECOMP12"
2638 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2640 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2641 & MPI_ROTAT2(lensend),inext,7700+isend,
2642 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2643 & iprev,7700+irecv,FG_COMM,status,IERR)
2644 c write (iout,*) "Gather PRECOMP21"
2646 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2647 & MPI_PRECOMP22(lensend),inext,8800+isend,
2648 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2649 & iprev,8800+irecv,FG_COMM,status,IERR)
2650 c write (iout,*) "Gather PRECOMP22"
2652 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2653 & MPI_PRECOMP23(lensend),inext,9900+isend,
2654 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2655 & MPI_PRECOMP23(lenrecv),
2656 & iprev,9900+irecv,FG_COMM,status,IERR)
2657 c write (iout,*) "Gather PRECOMP23"
2662 if (irecv.lt.0) irecv=nfgtasks1-1
2665 time_gather=time_gather+MPI_Wtime()-time00
2668 c if (fg_rank.eq.0) then
2669 write (iout,*) "Arrays UG and UGDER"
2671 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2672 & ((ug(l,k,i),l=1,2),k=1,2),
2673 & ((ugder(l,k,i),l=1,2),k=1,2)
2675 write (iout,*) "Arrays UG2 and UG2DER"
2677 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2678 & ((ug2(l,k,i),l=1,2),k=1,2),
2679 & ((ug2der(l,k,i),l=1,2),k=1,2)
2681 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2683 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2684 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2685 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2687 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2689 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2690 & costab(i),sintab(i),costab2(i),sintab2(i)
2692 write (iout,*) "Array MUDER"
2694 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2700 cd iti = itortyp(itype(i))
2703 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2704 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2709 C--------------------------------------------------------------------------
2710 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2712 C This subroutine calculates the average interaction energy and its gradient
2713 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2714 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2715 C The potential depends both on the distance of peptide-group centers and on
2716 C the orientation of the CA-CA virtual bonds.
2718 implicit real*8 (a-h,o-z)
2722 include 'DIMENSIONS'
2723 include 'COMMON.CONTROL'
2724 include 'COMMON.SETUP'
2725 include 'COMMON.IOUNITS'
2726 include 'COMMON.GEO'
2727 include 'COMMON.VAR'
2728 include 'COMMON.LOCAL'
2729 include 'COMMON.CHAIN'
2730 include 'COMMON.DERIV'
2731 include 'COMMON.INTERACT'
2732 include 'COMMON.CONTACTS'
2733 include 'COMMON.TORSION'
2734 include 'COMMON.VECTORS'
2735 include 'COMMON.FFIELD'
2736 include 'COMMON.TIME1'
2737 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2738 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2739 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2740 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2741 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2742 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2744 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2746 double precision scal_el /1.0d0/
2748 double precision scal_el /0.5d0/
2751 C 13-go grudnia roku pamietnego...
2752 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2753 & 0.0d0,1.0d0,0.0d0,
2754 & 0.0d0,0.0d0,1.0d0/
2755 cd write(iout,*) 'In EELEC'
2757 cd write(iout,*) 'Type',i
2758 cd write(iout,*) 'B1',B1(:,i)
2759 cd write(iout,*) 'B2',B2(:,i)
2760 cd write(iout,*) 'CC',CC(:,:,i)
2761 cd write(iout,*) 'DD',DD(:,:,i)
2762 cd write(iout,*) 'EE',EE(:,:,i)
2764 cd call check_vecgrad
2766 if (icheckgrad.eq.1) then
2768 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2770 dc_norm(k,i)=dc(k,i)*fac
2772 c write (iout,*) 'i',i,' fac',fac
2775 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2776 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2777 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2778 c call vec_and_deriv
2784 time_mat=time_mat+MPI_Wtime()-time01
2788 cd write (iout,*) 'i=',i
2790 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2793 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2794 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2807 cd print '(a)','Enter EELEC'
2808 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2810 gel_loc_loc(i)=0.0d0
2815 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2817 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2819 do i=iturn3_start,iturn3_end
2820 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2821 & .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
2825 dx_normi=dc_norm(1,i)
2826 dy_normi=dc_norm(2,i)
2827 dz_normi=dc_norm(3,i)
2828 xmedi=c(1,i)+0.5d0*dxi
2829 ymedi=c(2,i)+0.5d0*dyi
2830 zmedi=c(3,i)+0.5d0*dzi
2832 call eelecij(i,i+2,ees,evdw1,eel_loc)
2833 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2834 num_cont_hb(i)=num_conti
2836 do i=iturn4_start,iturn4_end
2837 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2838 & .or. itype(i+3).eq.ntyp1
2839 & .or. itype(i+4).eq.ntyp1) cycle
2843 dx_normi=dc_norm(1,i)
2844 dy_normi=dc_norm(2,i)
2845 dz_normi=dc_norm(3,i)
2846 xmedi=c(1,i)+0.5d0*dxi
2847 ymedi=c(2,i)+0.5d0*dyi
2848 zmedi=c(3,i)+0.5d0*dzi
2849 num_conti=num_cont_hb(i)
2850 call eelecij(i,i+3,ees,evdw1,eel_loc)
2851 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2852 & call eturn4(i,eello_turn4)
2853 num_cont_hb(i)=num_conti
2856 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2858 do i=iatel_s,iatel_e
2859 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2863 dx_normi=dc_norm(1,i)
2864 dy_normi=dc_norm(2,i)
2865 dz_normi=dc_norm(3,i)
2866 xmedi=c(1,i)+0.5d0*dxi
2867 ymedi=c(2,i)+0.5d0*dyi
2868 zmedi=c(3,i)+0.5d0*dzi
2869 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2870 num_conti=num_cont_hb(i)
2871 do j=ielstart(i),ielend(i)
2872 c write (iout,*) i,j,itype(i),itype(j)
2873 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2874 call eelecij(i,j,ees,evdw1,eel_loc)
2876 num_cont_hb(i)=num_conti
2878 c write (iout,*) "Number of loop steps in EELEC:",ind
2880 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2881 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2883 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2884 ccc eel_loc=eel_loc+eello_turn3
2885 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2888 C-------------------------------------------------------------------------------
2889 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2890 implicit real*8 (a-h,o-z)
2891 include 'DIMENSIONS'
2895 include 'COMMON.CONTROL'
2896 include 'COMMON.IOUNITS'
2897 include 'COMMON.GEO'
2898 include 'COMMON.VAR'
2899 include 'COMMON.LOCAL'
2900 include 'COMMON.CHAIN'
2901 include 'COMMON.DERIV'
2902 include 'COMMON.INTERACT'
2903 include 'COMMON.CONTACTS'
2904 include 'COMMON.TORSION'
2905 include 'COMMON.VECTORS'
2906 include 'COMMON.FFIELD'
2907 include 'COMMON.TIME1'
2908 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2909 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2910 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2911 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2912 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2913 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2915 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2917 double precision scal_el /1.0d0/
2919 double precision scal_el /0.5d0/
2922 C 13-go grudnia roku pamietnego...
2923 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2924 & 0.0d0,1.0d0,0.0d0,
2925 & 0.0d0,0.0d0,1.0d0/
2926 c time00=MPI_Wtime()
2927 cd write (iout,*) "eelecij",i,j
2931 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2932 aaa=app(iteli,itelj)
2933 bbb=bpp(iteli,itelj)
2934 ael6i=ael6(iteli,itelj)
2935 ael3i=ael3(iteli,itelj)
2939 dx_normj=dc_norm(1,j)
2940 dy_normj=dc_norm(2,j)
2941 dz_normj=dc_norm(3,j)
2942 xj=c(1,j)+0.5D0*dxj-xmedi
2943 yj=c(2,j)+0.5D0*dyj-ymedi
2944 zj=c(3,j)+0.5D0*dzj-zmedi
2945 rij=xj*xj+yj*yj+zj*zj
2951 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2952 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2953 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2954 fac=cosa-3.0D0*cosb*cosg
2956 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2957 if (j.eq.i+2) ev1=scal_el*ev1
2962 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2965 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2966 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2969 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2970 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2971 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2972 cd & xmedi,ymedi,zmedi,xj,yj,zj
2974 if (energy_dec) then
2975 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
2977 &,iteli,itelj,aaa,evdw1
2978 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2982 C Calculate contributions to the Cartesian gradient.
2985 facvdw=-6*rrmij*(ev1+evdwij)
2986 facel=-3*rrmij*(el1+eesij)
2992 * Radial derivatives. First process both termini of the fragment (i,j)
2998 c ghalf=0.5D0*ggg(k)
2999 c gelc(k,i)=gelc(k,i)+ghalf
3000 c gelc(k,j)=gelc(k,j)+ghalf
3002 c 9/28/08 AL Gradient compotents will be summed only at the end
3004 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3005 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3008 * Loop over residues i+1 thru j-1.
3012 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3019 c ghalf=0.5D0*ggg(k)
3020 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3021 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3023 c 9/28/08 AL Gradient compotents will be summed only at the end
3025 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3026 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3029 * Loop over residues i+1 thru j-1.
3033 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3040 fac=-3*rrmij*(facvdw+facvdw+facel)
3045 * Radial derivatives. First process both termini of the fragment (i,j)
3051 c ghalf=0.5D0*ggg(k)
3052 c gelc(k,i)=gelc(k,i)+ghalf
3053 c gelc(k,j)=gelc(k,j)+ghalf
3055 c 9/28/08 AL Gradient compotents will be summed only at the end
3057 gelc_long(k,j)=gelc(k,j)+ggg(k)
3058 gelc_long(k,i)=gelc(k,i)-ggg(k)
3061 * Loop over residues i+1 thru j-1.
3065 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3068 c 9/28/08 AL Gradient compotents will be summed only at the end
3073 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3074 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3080 ecosa=2.0D0*fac3*fac1+fac4
3083 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3084 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3086 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3087 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3089 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3090 cd & (dcosg(k),k=1,3)
3092 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3095 c ghalf=0.5D0*ggg(k)
3096 c gelc(k,i)=gelc(k,i)+ghalf
3097 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3098 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3099 c gelc(k,j)=gelc(k,j)+ghalf
3100 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3101 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3105 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3110 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3111 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3113 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3114 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3115 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3116 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3118 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3119 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3120 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3122 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3123 C energy of a peptide unit is assumed in the form of a second-order
3124 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3125 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3126 C are computed for EVERY pair of non-contiguous peptide groups.
3128 if (j.lt.nres-1) then
3139 muij(kkk)=mu(k,i)*mu(l,j)
3142 cd write (iout,*) 'EELEC: i',i,' j',j
3143 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3144 cd write(iout,*) 'muij',muij
3145 ury=scalar(uy(1,i),erij)
3146 urz=scalar(uz(1,i),erij)
3147 vry=scalar(uy(1,j),erij)
3148 vrz=scalar(uz(1,j),erij)
3149 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3150 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3151 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3152 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3153 fac=dsqrt(-ael6i)*r3ij
3158 cd write (iout,'(4i5,4f10.5)')
3159 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3160 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3161 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3162 cd & uy(:,j),uz(:,j)
3163 cd write (iout,'(4f10.5)')
3164 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3165 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3166 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3167 cd write (iout,'(9f10.5/)')
3168 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3169 C Derivatives of the elements of A in virtual-bond vectors
3170 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3172 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3173 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3174 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3175 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3176 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3177 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3178 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3179 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3180 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3181 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3182 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3183 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3185 C Compute radial contributions to the gradient
3203 C Add the contributions coming from er
3206 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3207 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3208 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3209 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3212 C Derivatives in DC(i)
3213 cgrad ghalf1=0.5d0*agg(k,1)
3214 cgrad ghalf2=0.5d0*agg(k,2)
3215 cgrad ghalf3=0.5d0*agg(k,3)
3216 cgrad ghalf4=0.5d0*agg(k,4)
3217 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3218 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3219 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3220 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3221 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3222 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3223 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3224 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3225 C Derivatives in DC(i+1)
3226 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3227 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3228 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3229 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3230 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3231 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3232 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3233 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3234 C Derivatives in DC(j)
3235 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3236 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3237 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3238 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3239 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3240 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3241 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3242 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3243 C Derivatives in DC(j+1) or DC(nres-1)
3244 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3245 & -3.0d0*vryg(k,3)*ury)
3246 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3247 & -3.0d0*vrzg(k,3)*ury)
3248 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3249 & -3.0d0*vryg(k,3)*urz)
3250 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3251 & -3.0d0*vrzg(k,3)*urz)
3252 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3254 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3267 aggi(k,l)=-aggi(k,l)
3268 aggi1(k,l)=-aggi1(k,l)
3269 aggj(k,l)=-aggj(k,l)
3270 aggj1(k,l)=-aggj1(k,l)
3273 if (j.lt.nres-1) then
3279 aggi(k,l)=-aggi(k,l)
3280 aggi1(k,l)=-aggi1(k,l)
3281 aggj(k,l)=-aggj(k,l)
3282 aggj1(k,l)=-aggj1(k,l)
3293 aggi(k,l)=-aggi(k,l)
3294 aggi1(k,l)=-aggi1(k,l)
3295 aggj(k,l)=-aggj(k,l)
3296 aggj1(k,l)=-aggj1(k,l)
3301 IF (wel_loc.gt.0.0d0) THEN
3302 C Contribution to the local-electrostatic energy coming from the i-j pair
3303 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3305 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3307 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3308 & 'eelloc',i,j,eel_loc_ij
3309 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3311 eel_loc=eel_loc+eel_loc_ij
3312 C Partial derivatives in virtual-bond dihedral angles gamma
3314 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3315 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3316 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3317 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3318 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3319 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3320 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3322 ggg(l)=agg(l,1)*muij(1)+
3323 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3324 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3325 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3326 cgrad ghalf=0.5d0*ggg(l)
3327 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3328 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3332 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3335 C Remaining derivatives of eello
3337 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3338 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3339 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3340 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3341 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3342 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3343 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3344 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3347 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3348 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3349 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3350 & .and. num_conti.le.maxconts) then
3351 c write (iout,*) i,j," entered corr"
3353 C Calculate the contact function. The ith column of the array JCONT will
3354 C contain the numbers of atoms that make contacts with the atom I (of numbers
3355 C greater than I). The arrays FACONT and GACONT will contain the values of
3356 C the contact function and its derivative.
3357 c r0ij=1.02D0*rpp(iteli,itelj)
3358 c r0ij=1.11D0*rpp(iteli,itelj)
3359 r0ij=2.20D0*rpp(iteli,itelj)
3360 c r0ij=1.55D0*rpp(iteli,itelj)
3361 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3362 if (fcont.gt.0.0D0) then
3363 num_conti=num_conti+1
3364 if (num_conti.gt.maxconts) then
3365 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3366 & ' will skip next contacts for this conf.'
3368 jcont_hb(num_conti,i)=j
3369 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3370 cd & " jcont_hb",jcont_hb(num_conti,i)
3371 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3372 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3373 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3375 d_cont(num_conti,i)=rij
3376 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3377 C --- Electrostatic-interaction matrix ---
3378 a_chuj(1,1,num_conti,i)=a22
3379 a_chuj(1,2,num_conti,i)=a23
3380 a_chuj(2,1,num_conti,i)=a32
3381 a_chuj(2,2,num_conti,i)=a33
3382 C --- Gradient of rij
3384 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3391 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3392 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3393 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3394 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3395 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3400 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3401 C Calculate contact energies
3403 wij=cosa-3.0D0*cosb*cosg
3406 c fac3=dsqrt(-ael6i)/r0ij**3
3407 fac3=dsqrt(-ael6i)*r3ij
3408 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3409 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3410 if (ees0tmp.gt.0) then
3411 ees0pij=dsqrt(ees0tmp)
3415 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3416 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3417 if (ees0tmp.gt.0) then
3418 ees0mij=dsqrt(ees0tmp)
3423 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3424 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3425 C Diagnostics. Comment out or remove after debugging!
3426 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3427 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3428 c ees0m(num_conti,i)=0.0D0
3430 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3431 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3432 C Angular derivatives of the contact function
3433 ees0pij1=fac3/ees0pij
3434 ees0mij1=fac3/ees0mij
3435 fac3p=-3.0D0*fac3*rrmij
3436 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3437 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3439 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3440 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3441 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3442 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3443 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3444 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3445 ecosap=ecosa1+ecosa2
3446 ecosbp=ecosb1+ecosb2
3447 ecosgp=ecosg1+ecosg2
3448 ecosam=ecosa1-ecosa2
3449 ecosbm=ecosb1-ecosb2
3450 ecosgm=ecosg1-ecosg2
3459 facont_hb(num_conti,i)=fcont
3460 fprimcont=fprimcont/rij
3461 cd facont_hb(num_conti,i)=1.0D0
3462 C Following line is for diagnostics.
3465 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3466 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3469 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3470 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3472 gggp(1)=gggp(1)+ees0pijp*xj
3473 gggp(2)=gggp(2)+ees0pijp*yj
3474 gggp(3)=gggp(3)+ees0pijp*zj
3475 gggm(1)=gggm(1)+ees0mijp*xj
3476 gggm(2)=gggm(2)+ees0mijp*yj
3477 gggm(3)=gggm(3)+ees0mijp*zj
3478 C Derivatives due to the contact function
3479 gacont_hbr(1,num_conti,i)=fprimcont*xj
3480 gacont_hbr(2,num_conti,i)=fprimcont*yj
3481 gacont_hbr(3,num_conti,i)=fprimcont*zj
3484 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3485 c following the change of gradient-summation algorithm.
3487 cgrad ghalfp=0.5D0*gggp(k)
3488 cgrad ghalfm=0.5D0*gggm(k)
3489 gacontp_hb1(k,num_conti,i)=!ghalfp
3490 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3491 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3492 gacontp_hb2(k,num_conti,i)=!ghalfp
3493 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3494 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3495 gacontp_hb3(k,num_conti,i)=gggp(k)
3496 gacontm_hb1(k,num_conti,i)=!ghalfm
3497 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3498 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3499 gacontm_hb2(k,num_conti,i)=!ghalfm
3500 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3501 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3502 gacontm_hb3(k,num_conti,i)=gggm(k)
3504 C Diagnostics. Comment out or remove after debugging!
3506 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3507 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3508 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3509 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3510 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3511 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3514 endif ! num_conti.le.maxconts
3517 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3520 ghalf=0.5d0*agg(l,k)
3521 aggi(l,k)=aggi(l,k)+ghalf
3522 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3523 aggj(l,k)=aggj(l,k)+ghalf
3526 if (j.eq.nres-1 .and. i.lt.j-2) then
3529 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3534 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3537 C-----------------------------------------------------------------------------
3538 subroutine eturn3(i,eello_turn3)
3539 C Third- and fourth-order contributions from turns
3540 implicit real*8 (a-h,o-z)
3541 include 'DIMENSIONS'
3542 include 'COMMON.IOUNITS'
3543 include 'COMMON.GEO'
3544 include 'COMMON.VAR'
3545 include 'COMMON.LOCAL'
3546 include 'COMMON.CHAIN'
3547 include 'COMMON.DERIV'
3548 include 'COMMON.INTERACT'
3549 include 'COMMON.CONTACTS'
3550 include 'COMMON.TORSION'
3551 include 'COMMON.VECTORS'
3552 include 'COMMON.FFIELD'
3553 include 'COMMON.CONTROL'
3555 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3556 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3557 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3558 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3559 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3560 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3561 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3564 c write (iout,*) "eturn3",i,j,j1,j2
3569 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3571 C Third-order contributions
3578 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3579 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3580 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3581 call transpose2(auxmat(1,1),auxmat1(1,1))
3582 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3583 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3584 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3585 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3586 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3587 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3588 cd & ' eello_turn3_num',4*eello_turn3_num
3589 C Derivatives in gamma(i)
3590 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3591 call transpose2(auxmat2(1,1),auxmat3(1,1))
3592 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3593 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3594 C Derivatives in gamma(i+1)
3595 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3596 call transpose2(auxmat2(1,1),auxmat3(1,1))
3597 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3598 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3599 & +0.5d0*(pizda(1,1)+pizda(2,2))
3600 C Cartesian derivatives
3602 c ghalf1=0.5d0*agg(l,1)
3603 c ghalf2=0.5d0*agg(l,2)
3604 c ghalf3=0.5d0*agg(l,3)
3605 c ghalf4=0.5d0*agg(l,4)
3606 a_temp(1,1)=aggi(l,1)!+ghalf1
3607 a_temp(1,2)=aggi(l,2)!+ghalf2
3608 a_temp(2,1)=aggi(l,3)!+ghalf3
3609 a_temp(2,2)=aggi(l,4)!+ghalf4
3610 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3611 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3612 & +0.5d0*(pizda(1,1)+pizda(2,2))
3613 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3614 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3615 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3616 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3617 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3618 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3619 & +0.5d0*(pizda(1,1)+pizda(2,2))
3620 a_temp(1,1)=aggj(l,1)!+ghalf1
3621 a_temp(1,2)=aggj(l,2)!+ghalf2
3622 a_temp(2,1)=aggj(l,3)!+ghalf3
3623 a_temp(2,2)=aggj(l,4)!+ghalf4
3624 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3625 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3626 & +0.5d0*(pizda(1,1)+pizda(2,2))
3627 a_temp(1,1)=aggj1(l,1)
3628 a_temp(1,2)=aggj1(l,2)
3629 a_temp(2,1)=aggj1(l,3)
3630 a_temp(2,2)=aggj1(l,4)
3631 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3632 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3633 & +0.5d0*(pizda(1,1)+pizda(2,2))
3637 C-------------------------------------------------------------------------------
3638 subroutine eturn4(i,eello_turn4)
3639 C Third- and fourth-order contributions from turns
3640 implicit real*8 (a-h,o-z)
3641 include 'DIMENSIONS'
3642 include 'COMMON.IOUNITS'
3643 include 'COMMON.GEO'
3644 include 'COMMON.VAR'
3645 include 'COMMON.LOCAL'
3646 include 'COMMON.CHAIN'
3647 include 'COMMON.DERIV'
3648 include 'COMMON.INTERACT'
3649 include 'COMMON.CONTACTS'
3650 include 'COMMON.TORSION'
3651 include 'COMMON.VECTORS'
3652 include 'COMMON.FFIELD'
3653 include 'COMMON.CONTROL'
3655 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3656 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3657 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3658 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3659 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3660 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3661 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3664 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3666 C Fourth-order contributions
3674 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3675 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3676 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3681 iti1=itortyp(itype(i+1))
3682 iti2=itortyp(itype(i+2))
3683 iti3=itortyp(itype(i+3))
3684 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3685 call transpose2(EUg(1,1,i+1),e1t(1,1))
3686 call transpose2(Eug(1,1,i+2),e2t(1,1))
3687 call transpose2(Eug(1,1,i+3),e3t(1,1))
3688 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3689 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3690 s1=scalar2(b1(1,iti2),auxvec(1))
3691 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3692 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3693 s2=scalar2(b1(1,iti1),auxvec(1))
3694 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3695 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3696 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3697 eello_turn4=eello_turn4-(s1+s2+s3)
3698 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3699 & 'eturn4',i,j,-(s1+s2+s3)
3700 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3701 cd & ' eello_turn4_num',8*eello_turn4_num
3702 C Derivatives in gamma(i)
3703 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3704 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3705 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3706 s1=scalar2(b1(1,iti2),auxvec(1))
3707 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3708 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3709 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3710 C Derivatives in gamma(i+1)
3711 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3712 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3713 s2=scalar2(b1(1,iti1),auxvec(1))
3714 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3715 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3716 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3717 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3718 C Derivatives in gamma(i+2)
3719 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3720 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3721 s1=scalar2(b1(1,iti2),auxvec(1))
3722 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3723 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3724 s2=scalar2(b1(1,iti1),auxvec(1))
3725 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3726 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3727 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3728 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3729 C Cartesian derivatives
3730 C Derivatives of this turn contributions in DC(i+2)
3731 if (j.lt.nres-1) then
3733 a_temp(1,1)=agg(l,1)
3734 a_temp(1,2)=agg(l,2)
3735 a_temp(2,1)=agg(l,3)
3736 a_temp(2,2)=agg(l,4)
3737 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3738 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3739 s1=scalar2(b1(1,iti2),auxvec(1))
3740 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3741 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3742 s2=scalar2(b1(1,iti1),auxvec(1))
3743 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3744 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3745 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3747 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3750 C Remaining derivatives of this turn contribution
3752 a_temp(1,1)=aggi(l,1)
3753 a_temp(1,2)=aggi(l,2)
3754 a_temp(2,1)=aggi(l,3)
3755 a_temp(2,2)=aggi(l,4)
3756 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3757 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3758 s1=scalar2(b1(1,iti2),auxvec(1))
3759 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3760 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3761 s2=scalar2(b1(1,iti1),auxvec(1))
3762 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3763 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3764 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3765 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3766 a_temp(1,1)=aggi1(l,1)
3767 a_temp(1,2)=aggi1(l,2)
3768 a_temp(2,1)=aggi1(l,3)
3769 a_temp(2,2)=aggi1(l,4)
3770 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3771 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3772 s1=scalar2(b1(1,iti2),auxvec(1))
3773 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3774 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3775 s2=scalar2(b1(1,iti1),auxvec(1))
3776 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3777 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3778 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3779 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3780 a_temp(1,1)=aggj(l,1)
3781 a_temp(1,2)=aggj(l,2)
3782 a_temp(2,1)=aggj(l,3)
3783 a_temp(2,2)=aggj(l,4)
3784 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3785 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3786 s1=scalar2(b1(1,iti2),auxvec(1))
3787 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3788 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3789 s2=scalar2(b1(1,iti1),auxvec(1))
3790 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3791 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3792 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3793 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3794 a_temp(1,1)=aggj1(l,1)
3795 a_temp(1,2)=aggj1(l,2)
3796 a_temp(2,1)=aggj1(l,3)
3797 a_temp(2,2)=aggj1(l,4)
3798 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3799 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3800 s1=scalar2(b1(1,iti2),auxvec(1))
3801 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3802 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3803 s2=scalar2(b1(1,iti1),auxvec(1))
3804 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3805 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3806 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3807 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3808 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3812 C-----------------------------------------------------------------------------
3813 subroutine vecpr(u,v,w)
3814 implicit real*8(a-h,o-z)
3815 dimension u(3),v(3),w(3)
3816 w(1)=u(2)*v(3)-u(3)*v(2)
3817 w(2)=-u(1)*v(3)+u(3)*v(1)
3818 w(3)=u(1)*v(2)-u(2)*v(1)
3821 C-----------------------------------------------------------------------------
3822 subroutine unormderiv(u,ugrad,unorm,ungrad)
3823 C This subroutine computes the derivatives of a normalized vector u, given
3824 C the derivatives computed without normalization conditions, ugrad. Returns
3827 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3828 double precision vec(3)
3829 double precision scalar
3831 c write (2,*) 'ugrad',ugrad
3834 vec(i)=scalar(ugrad(1,i),u(1))
3836 c write (2,*) 'vec',vec
3839 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3842 c write (2,*) 'ungrad',ungrad
3845 C-----------------------------------------------------------------------------
3846 subroutine escp_soft_sphere(evdw2,evdw2_14)
3848 C This subroutine calculates the excluded-volume interaction energy between
3849 C peptide-group centers and side chains and its gradient in virtual-bond and
3850 C side-chain vectors.
3852 implicit real*8 (a-h,o-z)
3853 include 'DIMENSIONS'
3854 include 'COMMON.GEO'
3855 include 'COMMON.VAR'
3856 include 'COMMON.LOCAL'
3857 include 'COMMON.CHAIN'
3858 include 'COMMON.DERIV'
3859 include 'COMMON.INTERACT'
3860 include 'COMMON.FFIELD'
3861 include 'COMMON.IOUNITS'
3862 include 'COMMON.CONTROL'
3867 cd print '(a)','Enter ESCP'
3868 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3869 do i=iatscp_s,iatscp_e
3870 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3872 xi=0.5D0*(c(1,i)+c(1,i+1))
3873 yi=0.5D0*(c(2,i)+c(2,i+1))
3874 zi=0.5D0*(c(3,i)+c(3,i+1))
3876 do iint=1,nscp_gr(i)
3878 do j=iscpstart(i,iint),iscpend(i,iint)
3879 if (itype(j).eq.ntyp1) cycle
3880 itypj=iabs(itype(j))
3881 C Uncomment following three lines for SC-p interactions
3885 C Uncomment following three lines for Ca-p interactions
3889 rij=xj*xj+yj*yj+zj*zj
3892 if (rij.lt.r0ijsq) then
3893 evdwij=0.25d0*(rij-r0ijsq)**2
3901 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3906 cgrad if (j.lt.i) then
3907 cd write (iout,*) 'j<i'
3908 C Uncomment following three lines for SC-p interactions
3910 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3913 cd write (iout,*) 'j>i'
3915 cgrad ggg(k)=-ggg(k)
3916 C Uncomment following line for SC-p interactions
3917 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3921 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3923 cgrad kstart=min0(i+1,j)
3924 cgrad kend=max0(i-1,j-1)
3925 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3926 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3927 cgrad do k=kstart,kend
3929 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3933 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3934 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3942 C-----------------------------------------------------------------------------
3943 subroutine escp(evdw2,evdw2_14)
3945 C This subroutine calculates the excluded-volume interaction energy between
3946 C peptide-group centers and side chains and its gradient in virtual-bond and
3947 C side-chain vectors.
3949 implicit real*8 (a-h,o-z)
3950 include 'DIMENSIONS'
3951 include 'COMMON.GEO'
3952 include 'COMMON.VAR'
3953 include 'COMMON.LOCAL'
3954 include 'COMMON.CHAIN'
3955 include 'COMMON.DERIV'
3956 include 'COMMON.INTERACT'
3957 include 'COMMON.FFIELD'
3958 include 'COMMON.IOUNITS'
3959 include 'COMMON.CONTROL'
3963 cd print '(a)','Enter ESCP'
3964 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3965 do i=iatscp_s,iatscp_e
3966 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3968 xi=0.5D0*(c(1,i)+c(1,i+1))
3969 yi=0.5D0*(c(2,i)+c(2,i+1))
3970 zi=0.5D0*(c(3,i)+c(3,i+1))
3972 do iint=1,nscp_gr(i)
3974 do j=iscpstart(i,iint),iscpend(i,iint)
3975 itypj=iabs(itype(j))
3976 if (itypj.eq.ntyp1) cycle
3977 C Uncomment following three lines for SC-p interactions
3981 C Uncomment following three lines for Ca-p interactions
3985 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3987 e1=fac*fac*aad(itypj,iteli)
3988 e2=fac*bad(itypj,iteli)
3989 if (iabs(j-i) .le. 2) then
3992 evdw2_14=evdw2_14+e1+e2
3996 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3997 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4000 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4002 fac=-(evdwij+e1)*rrij
4006 cgrad if (j.lt.i) then
4007 cd write (iout,*) 'j<i'
4008 C Uncomment following three lines for SC-p interactions
4010 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4013 cd write (iout,*) 'j>i'
4015 cgrad ggg(k)=-ggg(k)
4016 C Uncomment following line for SC-p interactions
4017 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4018 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4022 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4024 cgrad kstart=min0(i+1,j)
4025 cgrad kend=max0(i-1,j-1)
4026 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4027 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4028 cgrad do k=kstart,kend
4030 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4034 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4035 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4043 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4044 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4045 gradx_scp(j,i)=expon*gradx_scp(j,i)
4048 C******************************************************************************
4052 C To save time the factor EXPON has been extracted from ALL components
4053 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4056 C******************************************************************************
4059 C--------------------------------------------------------------------------
4060 subroutine edis(ehpb)
4062 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4064 implicit real*8 (a-h,o-z)
4065 include 'DIMENSIONS'
4066 include 'COMMON.SBRIDGE'
4067 include 'COMMON.CHAIN'
4068 include 'COMMON.DERIV'
4069 include 'COMMON.VAR'
4070 include 'COMMON.INTERACT'
4071 include 'COMMON.IOUNITS'
4074 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4075 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4076 if (link_end.eq.0) return
4077 do i=link_start,link_end
4078 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4079 C CA-CA distance used in regularization of structure.
4082 C iii and jjj point to the residues for which the distance is assigned.
4083 if (ii.gt.nres) then
4090 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4091 c & dhpb(i),dhpb1(i),forcon(i)
4092 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4093 C distance and angle dependent SS bond potential.
4094 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4095 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4096 if (.not.dyn_ss .and. i.le.nss) then
4097 C 15/02/13 CC dynamic SSbond - additional check
4098 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4099 & iabs(itype(jjj)).eq.1) then
4100 call ssbond_ene(iii,jjj,eij)
4103 cd write (iout,*) "eij",eij
4105 C Calculate the distance between the two points and its difference from the
4109 C Get the force constant corresponding to this distance.
4111 C Calculate the contribution to energy.
4112 ehpb=ehpb+waga*rdis*rdis
4114 C Evaluate gradient.
4117 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4118 cd & ' waga=',waga,' fac=',fac
4120 ggg(j)=fac*(c(j,jj)-c(j,ii))
4122 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4123 C If this is a SC-SC distance, we need to calculate the contributions to the
4124 C Cartesian gradient in the SC vectors (ghpbx).
4127 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4128 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4131 cgrad do j=iii,jjj-1
4133 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4137 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4138 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4145 C--------------------------------------------------------------------------
4146 subroutine ssbond_ene(i,j,eij)
4148 C Calculate the distance and angle dependent SS-bond potential energy
4149 C using a free-energy function derived based on RHF/6-31G** ab initio
4150 C calculations of diethyl disulfide.
4152 C A. Liwo and U. Kozlowska, 11/24/03
4154 implicit real*8 (a-h,o-z)
4155 include 'DIMENSIONS'
4156 include 'COMMON.SBRIDGE'
4157 include 'COMMON.CHAIN'
4158 include 'COMMON.DERIV'
4159 include 'COMMON.LOCAL'
4160 include 'COMMON.INTERACT'
4161 include 'COMMON.VAR'
4162 include 'COMMON.IOUNITS'
4163 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4164 itypi=iabs(itype(i))
4168 dxi=dc_norm(1,nres+i)
4169 dyi=dc_norm(2,nres+i)
4170 dzi=dc_norm(3,nres+i)
4171 c dsci_inv=dsc_inv(itypi)
4172 dsci_inv=vbld_inv(nres+i)
4173 itypj=iabs(itype(j))
4174 c dscj_inv=dsc_inv(itypj)
4175 dscj_inv=vbld_inv(nres+j)
4179 dxj=dc_norm(1,nres+j)
4180 dyj=dc_norm(2,nres+j)
4181 dzj=dc_norm(3,nres+j)
4182 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4187 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4188 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4189 om12=dxi*dxj+dyi*dyj+dzi*dzj
4191 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4192 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4198 deltat12=om2-om1+2.0d0
4200 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4201 & +akct*deltad*deltat12
4202 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4203 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4204 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4205 c & " deltat12",deltat12," eij",eij
4206 ed=2*akcm*deltad+akct*deltat12
4208 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4209 eom1=-2*akth*deltat1-pom1-om2*pom2
4210 eom2= 2*akth*deltat2+pom1-om1*pom2
4213 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4214 ghpbx(k,i)=ghpbx(k,i)-ggk
4215 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4216 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4217 ghpbx(k,j)=ghpbx(k,j)+ggk
4218 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4219 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4220 ghpbc(k,i)=ghpbc(k,i)-ggk
4221 ghpbc(k,j)=ghpbc(k,j)+ggk
4224 C Calculate the components of the gradient in DC and X
4228 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4233 C--------------------------------------------------------------------------
4234 subroutine ebond(estr)
4236 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4238 implicit real*8 (a-h,o-z)
4239 include 'DIMENSIONS'
4240 include 'COMMON.LOCAL'
4241 include 'COMMON.GEO'
4242 include 'COMMON.INTERACT'
4243 include 'COMMON.DERIV'
4244 include 'COMMON.VAR'
4245 include 'COMMON.CHAIN'
4246 include 'COMMON.IOUNITS'
4247 include 'COMMON.NAMES'
4248 include 'COMMON.FFIELD'
4249 include 'COMMON.CONTROL'
4250 include 'COMMON.SETUP'
4251 double precision u(3),ud(3)
4254 do i=ibondp_start,ibondp_end
4255 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4256 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4258 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4259 & *dc(j,i-1)/vbld(i)
4261 if (energy_dec) write(iout,*)
4262 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4264 diff = vbld(i)-vbldp0
4265 if (energy_dec) write (iout,*)
4266 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4269 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4271 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4274 estr=0.5d0*AKP*estr+estr1
4276 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4278 do i=ibond_start,ibond_end
4280 if (iti.ne.10 .and. iti.ne.ntyp1) then
4283 diff=vbld(i+nres)-vbldsc0(1,iti)
4284 if (energy_dec) write (iout,*)
4285 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4286 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4287 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4289 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4293 diff=vbld(i+nres)-vbldsc0(j,iti)
4294 ud(j)=aksc(j,iti)*diff
4295 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4309 uprod2=uprod2*u(k)*u(k)
4313 usumsqder=usumsqder+ud(j)*uprod2
4315 estr=estr+uprod/usum
4317 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4325 C--------------------------------------------------------------------------
4326 subroutine ebend(etheta)
4328 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4329 C angles gamma and its derivatives in consecutive thetas and gammas.
4331 implicit real*8 (a-h,o-z)
4332 include 'DIMENSIONS'
4333 include 'COMMON.LOCAL'
4334 include 'COMMON.GEO'
4335 include 'COMMON.INTERACT'
4336 include 'COMMON.DERIV'
4337 include 'COMMON.VAR'
4338 include 'COMMON.CHAIN'
4339 include 'COMMON.IOUNITS'
4340 include 'COMMON.NAMES'
4341 include 'COMMON.FFIELD'
4342 include 'COMMON.CONTROL'
4343 common /calcthet/ term1,term2,termm,diffak,ratak,
4344 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4345 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4346 double precision y(2),z(2)
4348 c time11=dexp(-2*time)
4351 c write (*,'(a,i2)') 'EBEND ICG=',icg
4352 do i=ithet_start,ithet_end
4353 if (itype(i-1).eq.ntyp1) cycle
4354 C Zero the energy function and its derivative at 0 or pi.
4355 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4357 ichir1=isign(1,itype(i-2))
4358 ichir2=isign(1,itype(i))
4359 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4360 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4361 if (itype(i-1).eq.10) then
4362 itype1=isign(10,itype(i-2))
4363 ichir11=isign(1,itype(i-2))
4364 ichir12=isign(1,itype(i-2))
4365 itype2=isign(10,itype(i))
4366 ichir21=isign(1,itype(i))
4367 ichir22=isign(1,itype(i))
4370 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4373 if (phii.ne.phii) phii=150.0
4383 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4386 if (phii1.ne.phii1) phii1=150.0
4398 C Calculate the "mean" value of theta from the part of the distribution
4399 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4400 C In following comments this theta will be referred to as t_c.
4401 thet_pred_mean=0.0d0
4403 athetk=athet(k,it,ichir1,ichir2)
4404 bthetk=bthet(k,it,ichir1,ichir2)
4406 athetk=athet(k,itype1,ichir11,ichir12)
4407 bthetk=bthet(k,itype2,ichir21,ichir22)
4409 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4411 dthett=thet_pred_mean*ssd
4412 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4413 C Derivatives of the "mean" values in gamma1 and gamma2.
4414 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4415 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4416 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4417 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4419 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4420 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4421 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4422 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4424 if (theta(i).gt.pi-delta) then
4425 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4427 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4428 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4429 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4431 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4433 else if (theta(i).lt.delta) then
4434 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4435 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4436 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4438 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4439 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4442 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4445 etheta=etheta+ethetai
4446 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4448 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4449 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4450 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4452 C Ufff.... We've done all this!!!
4455 C---------------------------------------------------------------------------
4456 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4458 implicit real*8 (a-h,o-z)
4459 include 'DIMENSIONS'
4460 include 'COMMON.LOCAL'
4461 include 'COMMON.IOUNITS'
4462 common /calcthet/ term1,term2,termm,diffak,ratak,
4463 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4464 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4465 C Calculate the contributions to both Gaussian lobes.
4466 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4467 C The "polynomial part" of the "standard deviation" of this part of
4471 sig=sig*thet_pred_mean+polthet(j,it)
4473 C Derivative of the "interior part" of the "standard deviation of the"
4474 C gamma-dependent Gaussian lobe in t_c.
4475 sigtc=3*polthet(3,it)
4477 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4480 C Set the parameters of both Gaussian lobes of the distribution.
4481 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4482 fac=sig*sig+sigc0(it)
4485 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4486 sigsqtc=-4.0D0*sigcsq*sigtc
4487 c print *,i,sig,sigtc,sigsqtc
4488 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4489 sigtc=-sigtc/(fac*fac)
4490 C Following variable is sigma(t_c)**(-2)
4491 sigcsq=sigcsq*sigcsq
4493 sig0inv=1.0D0/sig0i**2
4494 delthec=thetai-thet_pred_mean
4495 delthe0=thetai-theta0i
4496 term1=-0.5D0*sigcsq*delthec*delthec
4497 term2=-0.5D0*sig0inv*delthe0*delthe0
4498 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4499 C NaNs in taking the logarithm. We extract the largest exponent which is added
4500 C to the energy (this being the log of the distribution) at the end of energy
4501 C term evaluation for this virtual-bond angle.
4502 if (term1.gt.term2) then
4504 term2=dexp(term2-termm)
4508 term1=dexp(term1-termm)
4511 C The ratio between the gamma-independent and gamma-dependent lobes of
4512 C the distribution is a Gaussian function of thet_pred_mean too.
4513 diffak=gthet(2,it)-thet_pred_mean
4514 ratak=diffak/gthet(3,it)**2
4515 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4516 C Let's differentiate it in thet_pred_mean NOW.
4518 C Now put together the distribution terms to make complete distribution.
4519 termexp=term1+ak*term2
4520 termpre=sigc+ak*sig0i
4521 C Contribution of the bending energy from this theta is just the -log of
4522 C the sum of the contributions from the two lobes and the pre-exponential
4523 C factor. Simple enough, isn't it?
4524 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4525 C NOW the derivatives!!!
4526 C 6/6/97 Take into account the deformation.
4527 E_theta=(delthec*sigcsq*term1
4528 & +ak*delthe0*sig0inv*term2)/termexp
4529 E_tc=((sigtc+aktc*sig0i)/termpre
4530 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4531 & aktc*term2)/termexp)
4534 c-----------------------------------------------------------------------------
4535 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4536 implicit real*8 (a-h,o-z)
4537 include 'DIMENSIONS'
4538 include 'COMMON.LOCAL'
4539 include 'COMMON.IOUNITS'
4540 common /calcthet/ term1,term2,termm,diffak,ratak,
4541 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4542 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4543 delthec=thetai-thet_pred_mean
4544 delthe0=thetai-theta0i
4545 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4546 t3 = thetai-thet_pred_mean
4550 t14 = t12+t6*sigsqtc
4552 t21 = thetai-theta0i
4558 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4559 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4560 & *(-t12*t9-ak*sig0inv*t27)
4564 C--------------------------------------------------------------------------
4565 subroutine ebend(etheta)
4567 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4568 C angles gamma and its derivatives in consecutive thetas and gammas.
4569 C ab initio-derived potentials from
4570 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4572 implicit real*8 (a-h,o-z)
4573 include 'DIMENSIONS'
4574 include 'COMMON.LOCAL'
4575 include 'COMMON.GEO'
4576 include 'COMMON.INTERACT'
4577 include 'COMMON.DERIV'
4578 include 'COMMON.VAR'
4579 include 'COMMON.CHAIN'
4580 include 'COMMON.IOUNITS'
4581 include 'COMMON.NAMES'
4582 include 'COMMON.FFIELD'
4583 include 'COMMON.CONTROL'
4584 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4585 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4586 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4587 & sinph1ph2(maxdouble,maxdouble)
4588 logical lprn /.false./, lprn1 /.false./
4590 do i=ithet_start,ithet_end
4591 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4592 &(itype(i).eq.ntyp1)) cycle
4593 C print *,i,theta(i)
4594 if (iabs(itype(i+1)).eq.20) iblock=2
4595 if (iabs(itype(i+1)).ne.20) iblock=1
4599 theti2=0.5d0*theta(i)
4600 ityp2=ithetyp((itype(i-1)))
4602 coskt(k)=dcos(k*theti2)
4603 sinkt(k)=dsin(k*theti2)
4607 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4610 if (phii.ne.phii) phii=150.0
4614 ityp1=ithetyp((itype(i-2)))
4615 C propagation of chirality for glycine type
4617 cosph1(k)=dcos(k*phii)
4618 sinph1(k)=dsin(k*phii)
4623 ityp1=ithetyp((itype(i-2)))
4628 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4631 if (phii1.ne.phii1) phii1=150.0
4636 ityp3=ithetyp((itype(i)))
4638 cosph2(k)=dcos(k*phii1)
4639 sinph2(k)=dsin(k*phii1)
4643 ityp3=ithetyp((itype(i)))
4649 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4652 ccl=cosph1(l)*cosph2(k-l)
4653 ssl=sinph1(l)*sinph2(k-l)
4654 scl=sinph1(l)*cosph2(k-l)
4655 csl=cosph1(l)*sinph2(k-l)
4656 cosph1ph2(l,k)=ccl-ssl
4657 cosph1ph2(k,l)=ccl+ssl
4658 sinph1ph2(l,k)=scl+csl
4659 sinph1ph2(k,l)=scl-csl
4663 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4664 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4665 write (iout,*) "coskt and sinkt"
4667 write (iout,*) k,coskt(k),sinkt(k)
4671 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4672 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4675 & write (iout,*) "k",k,"
4676 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4677 & " ethetai",ethetai
4680 write (iout,*) "cosph and sinph"
4682 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4684 write (iout,*) "cosph1ph2 and sinph2ph2"
4687 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4688 & sinph1ph2(l,k),sinph1ph2(k,l)
4691 write(iout,*) "ethetai",ethetai
4696 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4697 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4698 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4699 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4700 ethetai=ethetai+sinkt(m)*aux
4701 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4702 dephii=dephii+k*sinkt(m)*(
4703 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4704 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4705 dephii1=dephii1+k*sinkt(m)*(
4706 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4707 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4709 & write (iout,*) "m",m," k",k," bbthet",
4710 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4711 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4712 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4713 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4714 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4717 C print *,"cosph1", (cosph1(k), k=1,nsingle)
4718 C print *,"cosph2", (cosph2(k), k=1,nsingle)
4719 C print *,"sinph1", (sinph1(k), k=1,nsingle)
4720 C print *,"sinph2", (sinph2(k), k=1,nsingle)
4722 & write(iout,*) "ethetai",ethetai
4723 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4727 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4728 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4729 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4730 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4731 ethetai=ethetai+sinkt(m)*aux
4732 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4733 dephii=dephii+l*sinkt(m)*(
4734 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4735 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4736 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4737 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4738 dephii1=dephii1+(k-l)*sinkt(m)*(
4739 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4740 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4741 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4742 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4744 write (iout,*) "m",m," k",k," l",l," ffthet",
4745 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4746 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4747 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4748 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4749 & " ethetai",ethetai
4750 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4751 & cosph1ph2(k,l)*sinkt(m),
4752 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4761 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4762 & i,theta(i)*rad2deg,phii*rad2deg,
4763 & phii1*rad2deg,ethetai
4765 etheta=etheta+ethetai
4766 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4767 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4768 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4774 c-----------------------------------------------------------------------------
4775 subroutine esc(escloc)
4776 C Calculate the local energy of a side chain and its derivatives in the
4777 C corresponding virtual-bond valence angles THETA and the spherical angles
4779 implicit real*8 (a-h,o-z)
4780 include 'DIMENSIONS'
4781 include 'COMMON.GEO'
4782 include 'COMMON.LOCAL'
4783 include 'COMMON.VAR'
4784 include 'COMMON.INTERACT'
4785 include 'COMMON.DERIV'
4786 include 'COMMON.CHAIN'
4787 include 'COMMON.IOUNITS'
4788 include 'COMMON.NAMES'
4789 include 'COMMON.FFIELD'
4790 include 'COMMON.CONTROL'
4791 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4792 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4793 common /sccalc/ time11,time12,time112,theti,it,nlobit
4796 c write (iout,'(a)') 'ESC'
4797 do i=loc_start,loc_end
4799 if (it.eq.ntyp1) cycle
4800 if (it.eq.10) goto 1
4801 nlobit=nlob(iabs(it))
4802 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4803 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4804 theti=theta(i+1)-pipol
4809 if (x(2).gt.pi-delta) then
4813 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4815 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4816 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4818 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4819 & ddersc0(1),dersc(1))
4820 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4821 & ddersc0(3),dersc(3))
4823 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4825 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4826 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4827 & dersc0(2),esclocbi,dersc02)
4828 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4830 call splinthet(x(2),0.5d0*delta,ss,ssd)
4835 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4837 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4838 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4840 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4842 c write (iout,*) escloci
4843 else if (x(2).lt.delta) then
4847 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4849 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4850 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4852 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4853 & ddersc0(1),dersc(1))
4854 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4855 & ddersc0(3),dersc(3))
4857 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4859 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4860 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4861 & dersc0(2),esclocbi,dersc02)
4862 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4867 call splinthet(x(2),0.5d0*delta,ss,ssd)
4869 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4871 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4872 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4874 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4875 c write (iout,*) escloci
4877 call enesc(x,escloci,dersc,ddummy,.false.)
4880 escloc=escloc+escloci
4881 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4882 & 'escloc',i,escloci
4883 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4885 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4887 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4888 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4893 C---------------------------------------------------------------------------
4894 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4895 implicit real*8 (a-h,o-z)
4896 include 'DIMENSIONS'
4897 include 'COMMON.GEO'
4898 include 'COMMON.LOCAL'
4899 include 'COMMON.IOUNITS'
4900 common /sccalc/ time11,time12,time112,theti,it,nlobit
4901 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4902 double precision contr(maxlob,-1:1)
4904 c write (iout,*) 'it=',it,' nlobit=',nlobit
4908 if (mixed) ddersc(j)=0.0d0
4912 C Because of periodicity of the dependence of the SC energy in omega we have
4913 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4914 C To avoid underflows, first compute & store the exponents.
4922 z(k)=x(k)-censc(k,j,it)
4927 Axk=Axk+gaussc(l,k,j,it)*z(l)
4933 expfac=expfac+Ax(k,j,iii)*z(k)
4941 C As in the case of ebend, we want to avoid underflows in exponentiation and
4942 C subsequent NaNs and INFs in energy calculation.
4943 C Find the largest exponent
4947 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4951 cd print *,'it=',it,' emin=',emin
4953 C Compute the contribution to SC energy and derivatives
4958 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
4959 if(adexp.ne.adexp) adexp=1.0
4962 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4964 cd print *,'j=',j,' expfac=',expfac
4965 escloc_i=escloc_i+expfac
4967 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4971 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4972 & +gaussc(k,2,j,it))*expfac
4979 dersc(1)=dersc(1)/cos(theti)**2
4980 ddersc(1)=ddersc(1)/cos(theti)**2
4983 escloci=-(dlog(escloc_i)-emin)
4985 dersc(j)=dersc(j)/escloc_i
4989 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4994 C------------------------------------------------------------------------------
4995 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4996 implicit real*8 (a-h,o-z)
4997 include 'DIMENSIONS'
4998 include 'COMMON.GEO'
4999 include 'COMMON.LOCAL'
5000 include 'COMMON.IOUNITS'
5001 common /sccalc/ time11,time12,time112,theti,it,nlobit
5002 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5003 double precision contr(maxlob)
5014 z(k)=x(k)-censc(k,j,it)
5020 Axk=Axk+gaussc(l,k,j,it)*z(l)
5026 expfac=expfac+Ax(k,j)*z(k)
5031 C As in the case of ebend, we want to avoid underflows in exponentiation and
5032 C subsequent NaNs and INFs in energy calculation.
5033 C Find the largest exponent
5036 if (emin.gt.contr(j)) emin=contr(j)
5040 C Compute the contribution to SC energy and derivatives
5044 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5045 escloc_i=escloc_i+expfac
5047 dersc(k)=dersc(k)+Ax(k,j)*expfac
5049 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5050 & +gaussc(1,2,j,it))*expfac
5054 dersc(1)=dersc(1)/cos(theti)**2
5055 dersc12=dersc12/cos(theti)**2
5056 escloci=-(dlog(escloc_i)-emin)
5058 dersc(j)=dersc(j)/escloc_i
5060 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5064 c----------------------------------------------------------------------------------
5065 subroutine esc(escloc)
5066 C Calculate the local energy of a side chain and its derivatives in the
5067 C corresponding virtual-bond valence angles THETA and the spherical angles
5068 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5069 C added by Urszula Kozlowska. 07/11/2007
5071 implicit real*8 (a-h,o-z)
5072 include 'DIMENSIONS'
5073 include 'COMMON.GEO'
5074 include 'COMMON.LOCAL'
5075 include 'COMMON.VAR'
5076 include 'COMMON.SCROT'
5077 include 'COMMON.INTERACT'
5078 include 'COMMON.DERIV'
5079 include 'COMMON.CHAIN'
5080 include 'COMMON.IOUNITS'
5081 include 'COMMON.NAMES'
5082 include 'COMMON.FFIELD'
5083 include 'COMMON.CONTROL'
5084 include 'COMMON.VECTORS'
5085 double precision x_prime(3),y_prime(3),z_prime(3)
5086 & , sumene,dsc_i,dp2_i,x(65),
5087 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5088 & de_dxx,de_dyy,de_dzz,de_dt
5089 double precision s1_t,s1_6_t,s2_t,s2_6_t
5091 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5092 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5093 & dt_dCi(3),dt_dCi1(3)
5094 common /sccalc/ time11,time12,time112,theti,it,nlobit
5097 do i=loc_start,loc_end
5098 if (itype(i).eq.ntyp1) cycle
5099 costtab(i+1) =dcos(theta(i+1))
5100 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5101 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5102 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5103 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5104 cosfac=dsqrt(cosfac2)
5105 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5106 sinfac=dsqrt(sinfac2)
5108 if (it.eq.10) goto 1
5110 C Compute the axes of tghe local cartesian coordinates system; store in
5111 c x_prime, y_prime and z_prime
5118 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5119 C & dc_norm(3,i+nres)
5121 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5122 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5125 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5128 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5129 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5130 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5131 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5132 c & " xy",scalar(x_prime(1),y_prime(1)),
5133 c & " xz",scalar(x_prime(1),z_prime(1)),
5134 c & " yy",scalar(y_prime(1),y_prime(1)),
5135 c & " yz",scalar(y_prime(1),z_prime(1)),
5136 c & " zz",scalar(z_prime(1),z_prime(1))
5138 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5139 C to local coordinate system. Store in xx, yy, zz.
5145 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5146 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5147 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5154 C Compute the energy of the ith side cbain
5156 c write (2,*) "xx",xx," yy",yy," zz",zz
5159 x(j) = sc_parmin(j,it)
5162 Cc diagnostics - remove later
5164 yy1 = dsin(alph(2))*dcos(omeg(2))
5165 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5166 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5167 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5169 C," --- ", xx_w,yy_w,zz_w
5172 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5173 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5175 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5176 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5178 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5179 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5180 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5181 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5182 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5184 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5185 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5186 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5187 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5188 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5190 dsc_i = 0.743d0+x(61)
5192 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5193 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5194 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5195 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5196 s1=(1+x(63))/(0.1d0 + dscp1)
5197 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5198 s2=(1+x(65))/(0.1d0 + dscp2)
5199 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5200 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5201 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5202 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5204 c & dscp1,dscp2,sumene
5205 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5206 escloc = escloc + sumene
5207 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5212 C This section to check the numerical derivatives of the energy of ith side
5213 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5214 C #define DEBUG in the code to turn it on.
5216 write (2,*) "sumene =",sumene
5220 write (2,*) xx,yy,zz
5221 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5222 de_dxx_num=(sumenep-sumene)/aincr
5224 write (2,*) "xx+ sumene from enesc=",sumenep
5227 write (2,*) xx,yy,zz
5228 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5229 de_dyy_num=(sumenep-sumene)/aincr
5231 write (2,*) "yy+ sumene from enesc=",sumenep
5234 write (2,*) xx,yy,zz
5235 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5236 de_dzz_num=(sumenep-sumene)/aincr
5238 write (2,*) "zz+ sumene from enesc=",sumenep
5239 costsave=cost2tab(i+1)
5240 sintsave=sint2tab(i+1)
5241 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5242 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5243 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5244 de_dt_num=(sumenep-sumene)/aincr
5245 write (2,*) " t+ sumene from enesc=",sumenep
5246 cost2tab(i+1)=costsave
5247 sint2tab(i+1)=sintsave
5248 C End of diagnostics section.
5251 C Compute the gradient of esc
5253 c zz=zz*dsign(1.0,dfloat(itype(i)))
5254 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5255 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5256 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5257 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5258 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5259 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5260 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5261 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5262 pom1=(sumene3*sint2tab(i+1)+sumene1)
5263 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5264 pom2=(sumene4*cost2tab(i+1)+sumene2)
5265 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5266 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5267 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5268 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5270 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5271 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5272 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5274 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5275 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5276 & +(pom1+pom2)*pom_dx
5278 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5281 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5282 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5283 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5285 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5286 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5287 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5288 & +x(59)*zz**2 +x(60)*xx*zz
5289 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5290 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5291 & +(pom1-pom2)*pom_dy
5293 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5296 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5297 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5298 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5299 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5300 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5301 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5302 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5303 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5305 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5308 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5309 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5310 & +pom1*pom_dt1+pom2*pom_dt2
5312 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5317 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5318 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5319 cosfac2xx=cosfac2*xx
5320 sinfac2yy=sinfac2*yy
5322 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5324 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5326 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5327 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5328 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5329 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5330 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5331 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5332 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5333 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5334 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5335 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5339 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5340 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5341 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5342 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5345 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5346 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5347 dZZ_XYZ(k)=vbld_inv(i+nres)*
5348 & (z_prime(k)-zz*dC_norm(k,i+nres))
5350 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5351 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5355 dXX_Ctab(k,i)=dXX_Ci(k)
5356 dXX_C1tab(k,i)=dXX_Ci1(k)
5357 dYY_Ctab(k,i)=dYY_Ci(k)
5358 dYY_C1tab(k,i)=dYY_Ci1(k)
5359 dZZ_Ctab(k,i)=dZZ_Ci(k)
5360 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5361 dXX_XYZtab(k,i)=dXX_XYZ(k)
5362 dYY_XYZtab(k,i)=dYY_XYZ(k)
5363 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5367 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5368 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5369 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5370 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5371 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5373 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5374 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5375 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5376 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5377 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5378 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5379 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5380 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5382 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5383 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5385 C to check gradient call subroutine check_grad
5391 c------------------------------------------------------------------------------
5392 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5394 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5395 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5396 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5397 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5399 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5400 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5402 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5403 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5404 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5405 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5406 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5408 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5409 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5410 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5411 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5412 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5414 dsc_i = 0.743d0+x(61)
5416 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5417 & *(xx*cost2+yy*sint2))
5418 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5419 & *(xx*cost2-yy*sint2))
5420 s1=(1+x(63))/(0.1d0 + dscp1)
5421 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5422 s2=(1+x(65))/(0.1d0 + dscp2)
5423 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5424 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5425 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5430 c------------------------------------------------------------------------------
5431 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5433 C This procedure calculates two-body contact function g(rij) and its derivative:
5436 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5439 C where x=(rij-r0ij)/delta
5441 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5444 double precision rij,r0ij,eps0ij,fcont,fprimcont
5445 double precision x,x2,x4,delta
5449 if (x.lt.-1.0D0) then
5452 else if (x.le.1.0D0) then
5455 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5456 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5463 c------------------------------------------------------------------------------
5464 subroutine splinthet(theti,delta,ss,ssder)
5465 implicit real*8 (a-h,o-z)
5466 include 'DIMENSIONS'
5467 include 'COMMON.VAR'
5468 include 'COMMON.GEO'
5471 if (theti.gt.pipol) then
5472 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5474 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5479 c------------------------------------------------------------------------------
5480 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5482 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5483 double precision ksi,ksi2,ksi3,a1,a2,a3
5484 a1=fprim0*delta/(f1-f0)
5490 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5491 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5494 c------------------------------------------------------------------------------
5495 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5497 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5498 double precision ksi,ksi2,ksi3,a1,a2,a3
5503 a2=3*(f1x-f0x)-2*fprim0x*delta
5504 a3=fprim0x*delta-2*(f1x-f0x)
5505 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5508 C-----------------------------------------------------------------------------
5510 C-----------------------------------------------------------------------------
5511 subroutine etor(etors,edihcnstr)
5512 implicit real*8 (a-h,o-z)
5513 include 'DIMENSIONS'
5514 include 'COMMON.VAR'
5515 include 'COMMON.GEO'
5516 include 'COMMON.LOCAL'
5517 include 'COMMON.TORSION'
5518 include 'COMMON.INTERACT'
5519 include 'COMMON.DERIV'
5520 include 'COMMON.CHAIN'
5521 include 'COMMON.NAMES'
5522 include 'COMMON.IOUNITS'
5523 include 'COMMON.FFIELD'
5524 include 'COMMON.TORCNSTR'
5525 include 'COMMON.CONTROL'
5527 C Set lprn=.true. for debugging
5531 do i=iphi_start,iphi_end
5533 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5534 & .or. itype(i).eq.ntyp1) cycle
5535 itori=itortyp(itype(i-2))
5536 itori1=itortyp(itype(i-1))
5539 C Proline-Proline pair is a special case...
5540 if (itori.eq.3 .and. itori1.eq.3) then
5541 if (phii.gt.-dwapi3) then
5543 fac=1.0D0/(1.0D0-cosphi)
5544 etorsi=v1(1,3,3)*fac
5545 etorsi=etorsi+etorsi
5546 etors=etors+etorsi-v1(1,3,3)
5547 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5548 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5551 v1ij=v1(j+1,itori,itori1)
5552 v2ij=v2(j+1,itori,itori1)
5555 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5556 if (energy_dec) etors_ii=etors_ii+
5557 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5558 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5562 v1ij=v1(j,itori,itori1)
5563 v2ij=v2(j,itori,itori1)
5566 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5567 if (energy_dec) etors_ii=etors_ii+
5568 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5569 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5572 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5575 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5576 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5577 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5578 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5579 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5581 ! 6/20/98 - dihedral angle constraints
5584 itori=idih_constr(i)
5587 if (difi.gt.drange(i)) then
5589 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5590 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5591 else if (difi.lt.-drange(i)) then
5593 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5594 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5596 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5597 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5599 ! write (iout,*) 'edihcnstr',edihcnstr
5602 c------------------------------------------------------------------------------
5603 subroutine etor_d(etors_d)
5607 c----------------------------------------------------------------------------
5609 subroutine etor(etors,edihcnstr)
5610 implicit real*8 (a-h,o-z)
5611 include 'DIMENSIONS'
5612 include 'COMMON.VAR'
5613 include 'COMMON.GEO'
5614 include 'COMMON.LOCAL'
5615 include 'COMMON.TORSION'
5616 include 'COMMON.INTERACT'
5617 include 'COMMON.DERIV'
5618 include 'COMMON.CHAIN'
5619 include 'COMMON.NAMES'
5620 include 'COMMON.IOUNITS'
5621 include 'COMMON.FFIELD'
5622 include 'COMMON.TORCNSTR'
5623 include 'COMMON.CONTROL'
5625 C Set lprn=.true. for debugging
5629 do i=iphi_start,iphi_end
5630 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5631 & .or. itype(i).eq.ntyp1) cycle
5633 if (iabs(itype(i)).eq.20) then
5638 itori=itortyp(itype(i-2))
5639 itori1=itortyp(itype(i-1))
5642 C Regular cosine and sine terms
5643 do j=1,nterm(itori,itori1,iblock)
5644 v1ij=v1(j,itori,itori1,iblock)
5645 v2ij=v2(j,itori,itori1,iblock)
5648 etors=etors+v1ij*cosphi+v2ij*sinphi
5649 if (energy_dec) etors_ii=etors_ii+
5650 & v1ij*cosphi+v2ij*sinphi
5651 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5655 C E = SUM ----------------------------------- - v1
5656 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5658 cosphi=dcos(0.5d0*phii)
5659 sinphi=dsin(0.5d0*phii)
5660 do j=1,nlor(itori,itori1,iblock)
5661 vl1ij=vlor1(j,itori,itori1)
5662 vl2ij=vlor2(j,itori,itori1)
5663 vl3ij=vlor3(j,itori,itori1)
5664 pom=vl2ij*cosphi+vl3ij*sinphi
5665 pom1=1.0d0/(pom*pom+1.0d0)
5666 etors=etors+vl1ij*pom1
5667 if (energy_dec) etors_ii=etors_ii+
5670 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5672 C Subtract the constant term
5673 etors=etors-v0(itori,itori1,iblock)
5674 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5675 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5677 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5678 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5679 & (v1(j,itori,itori1,iblock),j=1,6),
5680 & (v2(j,itori,itori1,iblock),j=1,6)
5681 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5682 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5684 ! 6/20/98 - dihedral angle constraints
5686 c do i=1,ndih_constr
5687 do i=idihconstr_start,idihconstr_end
5688 itori=idih_constr(i)
5690 difi=pinorm(phii-phi0(i))
5691 if (difi.gt.drange(i)) then
5693 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5694 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5695 else if (difi.lt.-drange(i)) then
5697 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5698 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5702 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5703 cd & rad2deg*phi0(i), rad2deg*drange(i),
5704 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5706 cd write (iout,*) 'edihcnstr',edihcnstr
5709 c----------------------------------------------------------------------------
5710 subroutine etor_d(etors_d)
5711 C 6/23/01 Compute double torsional energy
5712 implicit real*8 (a-h,o-z)
5713 include 'DIMENSIONS'
5714 include 'COMMON.VAR'
5715 include 'COMMON.GEO'
5716 include 'COMMON.LOCAL'
5717 include 'COMMON.TORSION'
5718 include 'COMMON.INTERACT'
5719 include 'COMMON.DERIV'
5720 include 'COMMON.CHAIN'
5721 include 'COMMON.NAMES'
5722 include 'COMMON.IOUNITS'
5723 include 'COMMON.FFIELD'
5724 include 'COMMON.TORCNSTR'
5726 C Set lprn=.true. for debugging
5730 c write(iout,*) "a tu??"
5731 do i=iphid_start,iphid_end
5732 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5733 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5734 itori=itortyp(itype(i-2))
5735 itori1=itortyp(itype(i-1))
5736 itori2=itortyp(itype(i))
5742 if (iabs(itype(i+1)).eq.20) iblock=2
5744 C Regular cosine and sine terms
5745 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5746 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5747 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5748 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5749 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5750 cosphi1=dcos(j*phii)
5751 sinphi1=dsin(j*phii)
5752 cosphi2=dcos(j*phii1)
5753 sinphi2=dsin(j*phii1)
5754 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5755 & v2cij*cosphi2+v2sij*sinphi2
5756 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5757 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5759 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5761 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5762 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5763 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5764 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5765 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5766 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5767 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5768 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5769 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5770 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5771 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5772 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5773 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5774 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5777 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5778 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5783 c------------------------------------------------------------------------------
5784 subroutine eback_sc_corr(esccor)
5785 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5786 c conformational states; temporarily implemented as differences
5787 c between UNRES torsional potentials (dependent on three types of
5788 c residues) and the torsional potentials dependent on all 20 types
5789 c of residues computed from AM1 energy surfaces of terminally-blocked
5790 c amino-acid residues.
5791 implicit real*8 (a-h,o-z)
5792 include 'DIMENSIONS'
5793 include 'COMMON.VAR'
5794 include 'COMMON.GEO'
5795 include 'COMMON.LOCAL'
5796 include 'COMMON.TORSION'
5797 include 'COMMON.SCCOR'
5798 include 'COMMON.INTERACT'
5799 include 'COMMON.DERIV'
5800 include 'COMMON.CHAIN'
5801 include 'COMMON.NAMES'
5802 include 'COMMON.IOUNITS'
5803 include 'COMMON.FFIELD'
5804 include 'COMMON.CONTROL'
5806 C Set lprn=.true. for debugging
5809 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5811 do i=itau_start,itau_end
5812 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5814 isccori=isccortyp(itype(i-2))
5815 isccori1=isccortyp(itype(i-1))
5816 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5818 do intertyp=1,3 !intertyp
5819 cc Added 09 May 2012 (Adasko)
5820 cc Intertyp means interaction type of backbone mainchain correlation:
5821 c 1 = SC...Ca...Ca...Ca
5822 c 2 = Ca...Ca...Ca...SC
5823 c 3 = SC...Ca...Ca...SCi
5825 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5826 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5827 & (itype(i-1).eq.ntyp1)))
5828 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5829 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5830 & .or.(itype(i).eq.ntyp1)))
5831 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5832 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5833 & (itype(i-3).eq.ntyp1)))) cycle
5834 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5835 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5837 do j=1,nterm_sccor(isccori,isccori1)
5838 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5839 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5840 cosphi=dcos(j*tauangle(intertyp,i))
5841 sinphi=dsin(j*tauangle(intertyp,i))
5842 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5843 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5845 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5846 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5848 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5849 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
5850 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
5851 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5852 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5858 c----------------------------------------------------------------------------
5859 subroutine multibody(ecorr)
5860 C This subroutine calculates multi-body contributions to energy following
5861 C the idea of Skolnick et al. If side chains I and J make a contact and
5862 C at the same time side chains I+1 and J+1 make a contact, an extra
5863 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5864 implicit real*8 (a-h,o-z)
5865 include 'DIMENSIONS'
5866 include 'COMMON.IOUNITS'
5867 include 'COMMON.DERIV'
5868 include 'COMMON.INTERACT'
5869 include 'COMMON.CONTACTS'
5870 double precision gx(3),gx1(3)
5873 C Set lprn=.true. for debugging
5877 write (iout,'(a)') 'Contact function values:'
5879 write (iout,'(i2,20(1x,i2,f10.5))')
5880 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5895 num_conti=num_cont(i)
5896 num_conti1=num_cont(i1)
5901 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5902 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5903 cd & ' ishift=',ishift
5904 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5905 C The system gains extra energy.
5906 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5907 endif ! j1==j+-ishift
5916 c------------------------------------------------------------------------------
5917 double precision function esccorr(i,j,k,l,jj,kk)
5918 implicit real*8 (a-h,o-z)
5919 include 'DIMENSIONS'
5920 include 'COMMON.IOUNITS'
5921 include 'COMMON.DERIV'
5922 include 'COMMON.INTERACT'
5923 include 'COMMON.CONTACTS'
5924 double precision gx(3),gx1(3)
5929 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5930 C Calculate the multi-body contribution to energy.
5931 C Calculate multi-body contributions to the gradient.
5932 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5933 cd & k,l,(gacont(m,kk,k),m=1,3)
5935 gx(m) =ekl*gacont(m,jj,i)
5936 gx1(m)=eij*gacont(m,kk,k)
5937 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5938 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5939 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5940 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5944 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5949 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5955 c------------------------------------------------------------------------------
5956 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5957 C This subroutine calculates multi-body contributions to hydrogen-bonding
5958 implicit real*8 (a-h,o-z)
5959 include 'DIMENSIONS'
5960 include 'COMMON.IOUNITS'
5963 parameter (max_cont=maxconts)
5964 parameter (max_dim=26)
5965 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5966 double precision zapas(max_dim,maxconts,max_fg_procs),
5967 & zapas_recv(max_dim,maxconts,max_fg_procs)
5968 common /przechowalnia/ zapas
5969 integer status(MPI_STATUS_SIZE),req(maxconts*2),
5970 & status_array(MPI_STATUS_SIZE,maxconts*2)
5972 include 'COMMON.SETUP'
5973 include 'COMMON.FFIELD'
5974 include 'COMMON.DERIV'
5975 include 'COMMON.INTERACT'
5976 include 'COMMON.CONTACTS'
5977 include 'COMMON.CONTROL'
5978 include 'COMMON.LOCAL'
5979 double precision gx(3),gx1(3),time00
5982 C Set lprn=.true. for debugging
5987 if (nfgtasks.le.1) goto 30
5989 write (iout,'(a)') 'Contact function values before RECEIVE:'
5991 write (iout,'(2i3,50(1x,i2,f5.2))')
5992 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5993 & j=1,num_cont_hb(i))
5997 do i=1,ntask_cont_from
6000 do i=1,ntask_cont_to
6003 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6005 C Make the list of contacts to send to send to other procesors
6006 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6008 do i=iturn3_start,iturn3_end
6009 c write (iout,*) "make contact list turn3",i," num_cont",
6011 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6013 do i=iturn4_start,iturn4_end
6014 c write (iout,*) "make contact list turn4",i," num_cont",
6016 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6020 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6022 do j=1,num_cont_hb(i)
6025 iproc=iint_sent_local(k,jjc,ii)
6026 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6027 if (iproc.gt.0) then
6028 ncont_sent(iproc)=ncont_sent(iproc)+1
6029 nn=ncont_sent(iproc)
6031 zapas(2,nn,iproc)=jjc
6032 zapas(3,nn,iproc)=facont_hb(j,i)
6033 zapas(4,nn,iproc)=ees0p(j,i)
6034 zapas(5,nn,iproc)=ees0m(j,i)
6035 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6036 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6037 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6038 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6039 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6040 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6041 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6042 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6043 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6044 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6045 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6046 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6047 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6048 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6049 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6050 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6051 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6052 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6053 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6054 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6055 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6062 & "Numbers of contacts to be sent to other processors",
6063 & (ncont_sent(i),i=1,ntask_cont_to)
6064 write (iout,*) "Contacts sent"
6065 do ii=1,ntask_cont_to
6067 iproc=itask_cont_to(ii)
6068 write (iout,*) nn," contacts to processor",iproc,
6069 & " of CONT_TO_COMM group"
6071 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6079 CorrelID1=nfgtasks+fg_rank+1
6081 C Receive the numbers of needed contacts from other processors
6082 do ii=1,ntask_cont_from
6083 iproc=itask_cont_from(ii)
6085 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6086 & FG_COMM,req(ireq),IERR)
6088 c write (iout,*) "IRECV ended"
6090 C Send the number of contacts needed by other processors
6091 do ii=1,ntask_cont_to
6092 iproc=itask_cont_to(ii)
6094 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6095 & FG_COMM,req(ireq),IERR)
6097 c write (iout,*) "ISEND ended"
6098 c write (iout,*) "number of requests (nn)",ireq
6101 & call MPI_Waitall(ireq,req,status_array,ierr)
6103 c & "Numbers of contacts to be received from other processors",
6104 c & (ncont_recv(i),i=1,ntask_cont_from)
6108 do ii=1,ntask_cont_from
6109 iproc=itask_cont_from(ii)
6111 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6112 c & " of CONT_TO_COMM group"
6116 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6117 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6118 c write (iout,*) "ireq,req",ireq,req(ireq)
6121 C Send the contacts to processors that need them
6122 do ii=1,ntask_cont_to
6123 iproc=itask_cont_to(ii)
6125 c write (iout,*) nn," contacts to processor",iproc,
6126 c & " of CONT_TO_COMM group"
6129 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6130 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6131 c write (iout,*) "ireq,req",ireq,req(ireq)
6133 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6137 c write (iout,*) "number of requests (contacts)",ireq
6138 c write (iout,*) "req",(req(i),i=1,4)
6141 & call MPI_Waitall(ireq,req,status_array,ierr)
6142 do iii=1,ntask_cont_from
6143 iproc=itask_cont_from(iii)
6146 write (iout,*) "Received",nn," contacts from processor",iproc,
6147 & " of CONT_FROM_COMM group"
6150 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6155 ii=zapas_recv(1,i,iii)
6156 c Flag the received contacts to prevent double-counting
6157 jj=-zapas_recv(2,i,iii)
6158 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6160 nnn=num_cont_hb(ii)+1
6163 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6164 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6165 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6166 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6167 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6168 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6169 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6170 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6171 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6172 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6173 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6174 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6175 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6176 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6177 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6178 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6179 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6180 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6181 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6182 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6183 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6184 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6185 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6186 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6191 write (iout,'(a)') 'Contact function values after receive:'
6193 write (iout,'(2i3,50(1x,i3,f5.2))')
6194 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6195 & j=1,num_cont_hb(i))
6202 write (iout,'(a)') 'Contact function values:'
6204 write (iout,'(2i3,50(1x,i3,f5.2))')
6205 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6206 & j=1,num_cont_hb(i))
6210 C Remove the loop below after debugging !!!
6217 C Calculate the local-electrostatic correlation terms
6218 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6220 num_conti=num_cont_hb(i)
6221 num_conti1=num_cont_hb(i+1)
6228 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6229 c & ' jj=',jj,' kk=',kk
6230 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6231 & .or. j.lt.0 .and. j1.gt.0) .and.
6232 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6233 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6234 C The system gains extra energy.
6235 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6236 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6237 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6239 else if (j1.eq.j) then
6240 C Contacts I-J and I-(J+1) occur simultaneously.
6241 C The system loses extra energy.
6242 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6247 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6248 c & ' jj=',jj,' kk=',kk
6250 C Contacts I-J and (I+1)-J occur simultaneously.
6251 C The system loses extra energy.
6252 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6259 c------------------------------------------------------------------------------
6260 subroutine add_hb_contact(ii,jj,itask)
6261 implicit real*8 (a-h,o-z)
6262 include "DIMENSIONS"
6263 include "COMMON.IOUNITS"
6266 parameter (max_cont=maxconts)
6267 parameter (max_dim=26)
6268 include "COMMON.CONTACTS"
6269 double precision zapas(max_dim,maxconts,max_fg_procs),
6270 & zapas_recv(max_dim,maxconts,max_fg_procs)
6271 common /przechowalnia/ zapas
6272 integer i,j,ii,jj,iproc,itask(4),nn
6273 c write (iout,*) "itask",itask
6276 if (iproc.gt.0) then
6277 do j=1,num_cont_hb(ii)
6279 c write (iout,*) "i",ii," j",jj," jjc",jjc
6281 ncont_sent(iproc)=ncont_sent(iproc)+1
6282 nn=ncont_sent(iproc)
6283 zapas(1,nn,iproc)=ii
6284 zapas(2,nn,iproc)=jjc
6285 zapas(3,nn,iproc)=facont_hb(j,ii)
6286 zapas(4,nn,iproc)=ees0p(j,ii)
6287 zapas(5,nn,iproc)=ees0m(j,ii)
6288 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6289 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6290 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6291 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6292 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6293 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6294 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6295 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6296 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6297 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6298 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6299 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6300 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6301 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6302 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6303 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6304 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6305 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6306 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6307 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6308 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6316 c------------------------------------------------------------------------------
6317 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6319 C This subroutine calculates multi-body contributions to hydrogen-bonding
6320 implicit real*8 (a-h,o-z)
6321 include 'DIMENSIONS'
6322 include 'COMMON.IOUNITS'
6325 parameter (max_cont=maxconts)
6326 parameter (max_dim=70)
6327 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6328 double precision zapas(max_dim,maxconts,max_fg_procs),
6329 & zapas_recv(max_dim,maxconts,max_fg_procs)
6330 common /przechowalnia/ zapas
6331 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6332 & status_array(MPI_STATUS_SIZE,maxconts*2)
6334 include 'COMMON.SETUP'
6335 include 'COMMON.FFIELD'
6336 include 'COMMON.DERIV'
6337 include 'COMMON.LOCAL'
6338 include 'COMMON.INTERACT'
6339 include 'COMMON.CONTACTS'
6340 include 'COMMON.CHAIN'
6341 include 'COMMON.CONTROL'
6342 double precision gx(3),gx1(3)
6343 integer num_cont_hb_old(maxres)
6345 double precision eello4,eello5,eelo6,eello_turn6
6346 external eello4,eello5,eello6,eello_turn6
6347 C Set lprn=.true. for debugging
6352 num_cont_hb_old(i)=num_cont_hb(i)
6356 if (nfgtasks.le.1) goto 30
6358 write (iout,'(a)') 'Contact function values before RECEIVE:'
6360 write (iout,'(2i3,50(1x,i2,f5.2))')
6361 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6362 & j=1,num_cont_hb(i))
6366 do i=1,ntask_cont_from
6369 do i=1,ntask_cont_to
6372 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6374 C Make the list of contacts to send to send to other procesors
6375 do i=iturn3_start,iturn3_end
6376 c write (iout,*) "make contact list turn3",i," num_cont",
6378 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6380 do i=iturn4_start,iturn4_end
6381 c write (iout,*) "make contact list turn4",i," num_cont",
6383 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6387 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6389 do j=1,num_cont_hb(i)
6392 iproc=iint_sent_local(k,jjc,ii)
6393 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6394 if (iproc.ne.0) then
6395 ncont_sent(iproc)=ncont_sent(iproc)+1
6396 nn=ncont_sent(iproc)
6398 zapas(2,nn,iproc)=jjc
6399 zapas(3,nn,iproc)=d_cont(j,i)
6403 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6408 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6416 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6427 & "Numbers of contacts to be sent to other processors",
6428 & (ncont_sent(i),i=1,ntask_cont_to)
6429 write (iout,*) "Contacts sent"
6430 do ii=1,ntask_cont_to
6432 iproc=itask_cont_to(ii)
6433 write (iout,*) nn," contacts to processor",iproc,
6434 & " of CONT_TO_COMM group"
6436 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6444 CorrelID1=nfgtasks+fg_rank+1
6446 C Receive the numbers of needed contacts from other processors
6447 do ii=1,ntask_cont_from
6448 iproc=itask_cont_from(ii)
6450 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6451 & FG_COMM,req(ireq),IERR)
6453 c write (iout,*) "IRECV ended"
6455 C Send the number of contacts needed by other processors
6456 do ii=1,ntask_cont_to
6457 iproc=itask_cont_to(ii)
6459 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6460 & FG_COMM,req(ireq),IERR)
6462 c write (iout,*) "ISEND ended"
6463 c write (iout,*) "number of requests (nn)",ireq
6466 & call MPI_Waitall(ireq,req,status_array,ierr)
6468 c & "Numbers of contacts to be received from other processors",
6469 c & (ncont_recv(i),i=1,ntask_cont_from)
6473 do ii=1,ntask_cont_from
6474 iproc=itask_cont_from(ii)
6476 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6477 c & " of CONT_TO_COMM group"
6481 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6482 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6483 c write (iout,*) "ireq,req",ireq,req(ireq)
6486 C Send the contacts to processors that need them
6487 do ii=1,ntask_cont_to
6488 iproc=itask_cont_to(ii)
6490 c write (iout,*) nn," contacts to processor",iproc,
6491 c & " of CONT_TO_COMM group"
6494 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6495 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6496 c write (iout,*) "ireq,req",ireq,req(ireq)
6498 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6502 c write (iout,*) "number of requests (contacts)",ireq
6503 c write (iout,*) "req",(req(i),i=1,4)
6506 & call MPI_Waitall(ireq,req,status_array,ierr)
6507 do iii=1,ntask_cont_from
6508 iproc=itask_cont_from(iii)
6511 write (iout,*) "Received",nn," contacts from processor",iproc,
6512 & " of CONT_FROM_COMM group"
6515 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6520 ii=zapas_recv(1,i,iii)
6521 c Flag the received contacts to prevent double-counting
6522 jj=-zapas_recv(2,i,iii)
6523 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6525 nnn=num_cont_hb(ii)+1
6528 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6532 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6537 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6545 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6554 write (iout,'(a)') 'Contact function values after receive:'
6556 write (iout,'(2i3,50(1x,i3,5f6.3))')
6557 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6558 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6565 write (iout,'(a)') 'Contact function values:'
6567 write (iout,'(2i3,50(1x,i2,5f6.3))')
6568 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6569 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6575 C Remove the loop below after debugging !!!
6582 C Calculate the dipole-dipole interaction energies
6583 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6584 do i=iatel_s,iatel_e+1
6585 num_conti=num_cont_hb(i)
6594 C Calculate the local-electrostatic correlation terms
6595 c write (iout,*) "gradcorr5 in eello5 before loop"
6597 c write (iout,'(i5,3f10.5)')
6598 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6600 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6601 c write (iout,*) "corr loop i",i
6603 num_conti=num_cont_hb(i)
6604 num_conti1=num_cont_hb(i+1)
6611 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6612 c & ' jj=',jj,' kk=',kk
6613 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6614 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6615 & .or. j.lt.0 .and. j1.gt.0) .and.
6616 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6617 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6618 C The system gains extra energy.
6620 sqd1=dsqrt(d_cont(jj,i))
6621 sqd2=dsqrt(d_cont(kk,i1))
6622 sred_geom = sqd1*sqd2
6623 IF (sred_geom.lt.cutoff_corr) THEN
6624 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6626 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6627 cd & ' jj=',jj,' kk=',kk
6628 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6629 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6631 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6632 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6635 cd write (iout,*) 'sred_geom=',sred_geom,
6636 cd & ' ekont=',ekont,' fprim=',fprimcont,
6637 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6638 cd write (iout,*) "g_contij",g_contij
6639 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6640 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6641 call calc_eello(i,jp,i+1,jp1,jj,kk)
6642 if (wcorr4.gt.0.0d0)
6643 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6644 if (energy_dec.and.wcorr4.gt.0.0d0)
6645 1 write (iout,'(a6,4i5,0pf7.3)')
6646 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6647 c write (iout,*) "gradcorr5 before eello5"
6649 c write (iout,'(i5,3f10.5)')
6650 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6652 if (wcorr5.gt.0.0d0)
6653 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6654 c write (iout,*) "gradcorr5 after eello5"
6656 c write (iout,'(i5,3f10.5)')
6657 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6659 if (energy_dec.and.wcorr5.gt.0.0d0)
6660 1 write (iout,'(a6,4i5,0pf7.3)')
6661 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6662 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6663 cd write(2,*)'ijkl',i,jp,i+1,jp1
6664 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6665 & .or. wturn6.eq.0.0d0))then
6666 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6667 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6668 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6669 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6670 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6671 cd & 'ecorr6=',ecorr6
6672 cd write (iout,'(4e15.5)') sred_geom,
6673 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6674 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6675 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6676 else if (wturn6.gt.0.0d0
6677 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6678 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6679 eturn6=eturn6+eello_turn6(i,jj,kk)
6680 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6681 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6682 cd write (2,*) 'multibody_eello:eturn6',eturn6
6691 num_cont_hb(i)=num_cont_hb_old(i)
6693 c write (iout,*) "gradcorr5 in eello5"
6695 c write (iout,'(i5,3f10.5)')
6696 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6700 c------------------------------------------------------------------------------
6701 subroutine add_hb_contact_eello(ii,jj,itask)
6702 implicit real*8 (a-h,o-z)
6703 include "DIMENSIONS"
6704 include "COMMON.IOUNITS"
6707 parameter (max_cont=maxconts)
6708 parameter (max_dim=70)
6709 include "COMMON.CONTACTS"
6710 double precision zapas(max_dim,maxconts,max_fg_procs),
6711 & zapas_recv(max_dim,maxconts,max_fg_procs)
6712 common /przechowalnia/ zapas
6713 integer i,j,ii,jj,iproc,itask(4),nn
6714 c write (iout,*) "itask",itask
6717 if (iproc.gt.0) then
6718 do j=1,num_cont_hb(ii)
6720 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6722 ncont_sent(iproc)=ncont_sent(iproc)+1
6723 nn=ncont_sent(iproc)
6724 zapas(1,nn,iproc)=ii
6725 zapas(2,nn,iproc)=jjc
6726 zapas(3,nn,iproc)=d_cont(j,ii)
6730 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6735 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6743 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6755 c------------------------------------------------------------------------------
6756 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6757 implicit real*8 (a-h,o-z)
6758 include 'DIMENSIONS'
6759 include 'COMMON.IOUNITS'
6760 include 'COMMON.DERIV'
6761 include 'COMMON.INTERACT'
6762 include 'COMMON.CONTACTS'
6763 double precision gx(3),gx1(3)
6773 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6774 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6775 C Following 4 lines for diagnostics.
6780 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6781 c & 'Contacts ',i,j,
6782 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6783 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6785 C Calculate the multi-body contribution to energy.
6786 c ecorr=ecorr+ekont*ees
6787 C Calculate multi-body contributions to the gradient.
6788 coeffpees0pij=coeffp*ees0pij
6789 coeffmees0mij=coeffm*ees0mij
6790 coeffpees0pkl=coeffp*ees0pkl
6791 coeffmees0mkl=coeffm*ees0mkl
6793 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6794 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6795 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6796 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6797 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6798 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6799 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6800 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6801 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6802 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6803 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6804 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6805 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6806 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6807 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6808 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6809 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6810 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6811 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6812 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6813 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6814 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6815 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6816 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6817 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6822 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6823 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6824 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6825 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6830 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6831 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6832 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6833 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6836 c write (iout,*) "ehbcorr",ekont*ees
6841 C---------------------------------------------------------------------------
6842 subroutine dipole(i,j,jj)
6843 implicit real*8 (a-h,o-z)
6844 include 'DIMENSIONS'
6845 include 'COMMON.IOUNITS'
6846 include 'COMMON.CHAIN'
6847 include 'COMMON.FFIELD'
6848 include 'COMMON.DERIV'
6849 include 'COMMON.INTERACT'
6850 include 'COMMON.CONTACTS'
6851 include 'COMMON.TORSION'
6852 include 'COMMON.VAR'
6853 include 'COMMON.GEO'
6854 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6856 iti1 = itortyp(itype(i+1))
6857 if (j.lt.nres-1) then
6858 itj1 = itortyp(itype(j+1))
6863 dipi(iii,1)=Ub2(iii,i)
6864 dipderi(iii)=Ub2der(iii,i)
6865 dipi(iii,2)=b1(iii,iti1)
6866 dipj(iii,1)=Ub2(iii,j)
6867 dipderj(iii)=Ub2der(iii,j)
6868 dipj(iii,2)=b1(iii,itj1)
6872 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6875 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6882 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6886 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6891 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6892 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6894 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6896 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6898 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6903 C---------------------------------------------------------------------------
6904 subroutine calc_eello(i,j,k,l,jj,kk)
6906 C This subroutine computes matrices and vectors needed to calculate
6907 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6909 implicit real*8 (a-h,o-z)
6910 include 'DIMENSIONS'
6911 include 'COMMON.IOUNITS'
6912 include 'COMMON.CHAIN'
6913 include 'COMMON.DERIV'
6914 include 'COMMON.INTERACT'
6915 include 'COMMON.CONTACTS'
6916 include 'COMMON.TORSION'
6917 include 'COMMON.VAR'
6918 include 'COMMON.GEO'
6919 include 'COMMON.FFIELD'
6920 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6921 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6924 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6925 cd & ' jj=',jj,' kk=',kk
6926 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6927 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6928 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6931 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6932 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6935 call transpose2(aa1(1,1),aa1t(1,1))
6936 call transpose2(aa2(1,1),aa2t(1,1))
6939 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6940 & aa1tder(1,1,lll,kkk))
6941 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6942 & aa2tder(1,1,lll,kkk))
6946 C parallel orientation of the two CA-CA-CA frames.
6948 iti=itortyp(itype(i))
6952 itk1=itortyp(itype(k+1))
6953 itj=itortyp(itype(j))
6954 if (l.lt.nres-1) then
6955 itl1=itortyp(itype(l+1))
6959 C A1 kernel(j+1) A2T
6961 cd write (iout,'(3f10.5,5x,3f10.5)')
6962 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6964 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6965 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6966 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6967 C Following matrices are needed only for 6-th order cumulants
6968 IF (wcorr6.gt.0.0d0) THEN
6969 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6970 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6971 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6972 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6973 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6974 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6975 & ADtEAderx(1,1,1,1,1,1))
6977 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6978 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6979 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6980 & ADtEA1derx(1,1,1,1,1,1))
6982 C End 6-th order cumulants
6985 cd write (2,*) 'In calc_eello6'
6987 cd write (2,*) 'iii=',iii
6989 cd write (2,*) 'kkk=',kkk
6991 cd write (2,'(3(2f10.5),5x)')
6992 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6997 call transpose2(EUgder(1,1,k),auxmat(1,1))
6998 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6999 call transpose2(EUg(1,1,k),auxmat(1,1))
7000 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7001 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7005 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7006 & EAEAderx(1,1,lll,kkk,iii,1))
7010 C A1T kernel(i+1) A2
7011 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7012 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7013 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7014 C Following matrices are needed only for 6-th order cumulants
7015 IF (wcorr6.gt.0.0d0) THEN
7016 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7017 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7018 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7019 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7020 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7021 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7022 & ADtEAderx(1,1,1,1,1,2))
7023 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7024 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7025 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7026 & ADtEA1derx(1,1,1,1,1,2))
7028 C End 6-th order cumulants
7029 call transpose2(EUgder(1,1,l),auxmat(1,1))
7030 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7031 call transpose2(EUg(1,1,l),auxmat(1,1))
7032 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7033 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7037 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7038 & EAEAderx(1,1,lll,kkk,iii,2))
7043 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7044 C They are needed only when the fifth- or the sixth-order cumulants are
7046 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7047 call transpose2(AEA(1,1,1),auxmat(1,1))
7048 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7049 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7050 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7051 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7052 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7053 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7054 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7055 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7056 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7057 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7058 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7059 call transpose2(AEA(1,1,2),auxmat(1,1))
7060 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7061 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7062 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7063 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7064 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7065 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7066 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7067 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7068 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7069 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7070 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7071 C Calculate the Cartesian derivatives of the vectors.
7075 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7076 call matvec2(auxmat(1,1),b1(1,iti),
7077 & AEAb1derx(1,lll,kkk,iii,1,1))
7078 call matvec2(auxmat(1,1),Ub2(1,i),
7079 & AEAb2derx(1,lll,kkk,iii,1,1))
7080 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7081 & AEAb1derx(1,lll,kkk,iii,2,1))
7082 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7083 & AEAb2derx(1,lll,kkk,iii,2,1))
7084 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7085 call matvec2(auxmat(1,1),b1(1,itj),
7086 & AEAb1derx(1,lll,kkk,iii,1,2))
7087 call matvec2(auxmat(1,1),Ub2(1,j),
7088 & AEAb2derx(1,lll,kkk,iii,1,2))
7089 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7090 & AEAb1derx(1,lll,kkk,iii,2,2))
7091 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7092 & AEAb2derx(1,lll,kkk,iii,2,2))
7099 C Antiparallel orientation of the two CA-CA-CA frames.
7101 iti=itortyp(itype(i))
7105 itk1=itortyp(itype(k+1))
7106 itl=itortyp(itype(l))
7107 itj=itortyp(itype(j))
7108 if (j.lt.nres-1) then
7109 itj1=itortyp(itype(j+1))
7113 C A2 kernel(j-1)T A1T
7114 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7115 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7116 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7117 C Following matrices are needed only for 6-th order cumulants
7118 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7119 & j.eq.i+4 .and. l.eq.i+3)) THEN
7120 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7121 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7122 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7123 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7124 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7125 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7126 & ADtEAderx(1,1,1,1,1,1))
7127 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7128 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7129 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7130 & ADtEA1derx(1,1,1,1,1,1))
7132 C End 6-th order cumulants
7133 call transpose2(EUgder(1,1,k),auxmat(1,1))
7134 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7135 call transpose2(EUg(1,1,k),auxmat(1,1))
7136 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7137 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7141 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7142 & EAEAderx(1,1,lll,kkk,iii,1))
7146 C A2T kernel(i+1)T A1
7147 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7148 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7149 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7150 C Following matrices are needed only for 6-th order cumulants
7151 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7152 & j.eq.i+4 .and. l.eq.i+3)) THEN
7153 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7154 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7155 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7156 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7157 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7158 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7159 & ADtEAderx(1,1,1,1,1,2))
7160 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7161 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7162 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7163 & ADtEA1derx(1,1,1,1,1,2))
7165 C End 6-th order cumulants
7166 call transpose2(EUgder(1,1,j),auxmat(1,1))
7167 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7168 call transpose2(EUg(1,1,j),auxmat(1,1))
7169 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7170 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7174 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7175 & EAEAderx(1,1,lll,kkk,iii,2))
7180 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7181 C They are needed only when the fifth- or the sixth-order cumulants are
7183 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7184 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7185 call transpose2(AEA(1,1,1),auxmat(1,1))
7186 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7187 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7188 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7189 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7190 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7191 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7192 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7193 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7194 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7195 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7196 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7197 call transpose2(AEA(1,1,2),auxmat(1,1))
7198 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7199 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7200 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7201 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7202 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7203 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7204 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7205 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7206 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7207 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7208 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7209 C Calculate the Cartesian derivatives of the vectors.
7213 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7214 call matvec2(auxmat(1,1),b1(1,iti),
7215 & AEAb1derx(1,lll,kkk,iii,1,1))
7216 call matvec2(auxmat(1,1),Ub2(1,i),
7217 & AEAb2derx(1,lll,kkk,iii,1,1))
7218 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7219 & AEAb1derx(1,lll,kkk,iii,2,1))
7220 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7221 & AEAb2derx(1,lll,kkk,iii,2,1))
7222 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7223 call matvec2(auxmat(1,1),b1(1,itl),
7224 & AEAb1derx(1,lll,kkk,iii,1,2))
7225 call matvec2(auxmat(1,1),Ub2(1,l),
7226 & AEAb2derx(1,lll,kkk,iii,1,2))
7227 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7228 & AEAb1derx(1,lll,kkk,iii,2,2))
7229 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7230 & AEAb2derx(1,lll,kkk,iii,2,2))
7239 C---------------------------------------------------------------------------
7240 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7241 & KK,KKderg,AKA,AKAderg,AKAderx)
7245 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7246 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7247 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7252 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7254 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7257 cd if (lprn) write (2,*) 'In kernel'
7259 cd if (lprn) write (2,*) 'kkk=',kkk
7261 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7262 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7264 cd write (2,*) 'lll=',lll
7265 cd write (2,*) 'iii=1'
7267 cd write (2,'(3(2f10.5),5x)')
7268 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7271 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7272 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7274 cd write (2,*) 'lll=',lll
7275 cd write (2,*) 'iii=2'
7277 cd write (2,'(3(2f10.5),5x)')
7278 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7285 C---------------------------------------------------------------------------
7286 double precision function eello4(i,j,k,l,jj,kk)
7287 implicit real*8 (a-h,o-z)
7288 include 'DIMENSIONS'
7289 include 'COMMON.IOUNITS'
7290 include 'COMMON.CHAIN'
7291 include 'COMMON.DERIV'
7292 include 'COMMON.INTERACT'
7293 include 'COMMON.CONTACTS'
7294 include 'COMMON.TORSION'
7295 include 'COMMON.VAR'
7296 include 'COMMON.GEO'
7297 double precision pizda(2,2),ggg1(3),ggg2(3)
7298 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7302 cd print *,'eello4:',i,j,k,l,jj,kk
7303 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7304 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7305 cold eij=facont_hb(jj,i)
7306 cold ekl=facont_hb(kk,k)
7308 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7309 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7310 gcorr_loc(k-1)=gcorr_loc(k-1)
7311 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7313 gcorr_loc(l-1)=gcorr_loc(l-1)
7314 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7316 gcorr_loc(j-1)=gcorr_loc(j-1)
7317 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7322 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7323 & -EAEAderx(2,2,lll,kkk,iii,1)
7324 cd derx(lll,kkk,iii)=0.0d0
7328 cd gcorr_loc(l-1)=0.0d0
7329 cd gcorr_loc(j-1)=0.0d0
7330 cd gcorr_loc(k-1)=0.0d0
7332 cd write (iout,*)'Contacts have occurred for peptide groups',
7333 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7334 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7335 if (j.lt.nres-1) then
7342 if (l.lt.nres-1) then
7350 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7351 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7352 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7353 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7354 cgrad ghalf=0.5d0*ggg1(ll)
7355 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7356 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7357 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7358 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7359 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7360 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7361 cgrad ghalf=0.5d0*ggg2(ll)
7362 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7363 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7364 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7365 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7366 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7367 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7371 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7376 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7381 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7386 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7390 cd write (2,*) iii,gcorr_loc(iii)
7393 cd write (2,*) 'ekont',ekont
7394 cd write (iout,*) 'eello4',ekont*eel4
7397 C---------------------------------------------------------------------------
7398 double precision function eello5(i,j,k,l,jj,kk)
7399 implicit real*8 (a-h,o-z)
7400 include 'DIMENSIONS'
7401 include 'COMMON.IOUNITS'
7402 include 'COMMON.CHAIN'
7403 include 'COMMON.DERIV'
7404 include 'COMMON.INTERACT'
7405 include 'COMMON.CONTACTS'
7406 include 'COMMON.TORSION'
7407 include 'COMMON.VAR'
7408 include 'COMMON.GEO'
7409 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7410 double precision ggg1(3),ggg2(3)
7411 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7416 C /l\ / \ \ / \ / \ / C
7417 C / \ / \ \ / \ / \ / C
7418 C j| o |l1 | o | o| o | | o |o C
7419 C \ |/k\| |/ \| / |/ \| |/ \| C
7420 C \i/ \ / \ / / \ / \ C
7422 C (I) (II) (III) (IV) C
7424 C eello5_1 eello5_2 eello5_3 eello5_4 C
7426 C Antiparallel chains C
7429 C /j\ / \ \ / \ / \ / C
7430 C / \ / \ \ / \ / \ / C
7431 C j1| o |l | o | o| o | | o |o C
7432 C \ |/k\| |/ \| / |/ \| |/ \| C
7433 C \i/ \ / \ / / \ / \ C
7435 C (I) (II) (III) (IV) C
7437 C eello5_1 eello5_2 eello5_3 eello5_4 C
7439 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7441 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7442 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7447 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7449 itk=itortyp(itype(k))
7450 itl=itortyp(itype(l))
7451 itj=itortyp(itype(j))
7456 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7457 cd & eel5_3_num,eel5_4_num)
7461 derx(lll,kkk,iii)=0.0d0
7465 cd eij=facont_hb(jj,i)
7466 cd ekl=facont_hb(kk,k)
7468 cd write (iout,*)'Contacts have occurred for peptide groups',
7469 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7471 C Contribution from the graph I.
7472 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7473 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7474 call transpose2(EUg(1,1,k),auxmat(1,1))
7475 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7476 vv(1)=pizda(1,1)-pizda(2,2)
7477 vv(2)=pizda(1,2)+pizda(2,1)
7478 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7479 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7480 C Explicit gradient in virtual-dihedral angles.
7481 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7482 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7483 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7484 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7485 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7486 vv(1)=pizda(1,1)-pizda(2,2)
7487 vv(2)=pizda(1,2)+pizda(2,1)
7488 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7489 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7490 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7491 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7492 vv(1)=pizda(1,1)-pizda(2,2)
7493 vv(2)=pizda(1,2)+pizda(2,1)
7495 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7496 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7497 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7499 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7500 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7501 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7503 C Cartesian gradient
7507 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7509 vv(1)=pizda(1,1)-pizda(2,2)
7510 vv(2)=pizda(1,2)+pizda(2,1)
7511 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7512 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7513 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7519 C Contribution from graph II
7520 call transpose2(EE(1,1,itk),auxmat(1,1))
7521 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7522 vv(1)=pizda(1,1)+pizda(2,2)
7523 vv(2)=pizda(2,1)-pizda(1,2)
7524 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7525 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7526 C Explicit gradient in virtual-dihedral angles.
7527 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7528 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7529 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7530 vv(1)=pizda(1,1)+pizda(2,2)
7531 vv(2)=pizda(2,1)-pizda(1,2)
7533 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7534 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7535 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7537 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7538 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7539 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7541 C Cartesian gradient
7545 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7547 vv(1)=pizda(1,1)+pizda(2,2)
7548 vv(2)=pizda(2,1)-pizda(1,2)
7549 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7550 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7551 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7559 C Parallel orientation
7560 C Contribution from graph III
7561 call transpose2(EUg(1,1,l),auxmat(1,1))
7562 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7563 vv(1)=pizda(1,1)-pizda(2,2)
7564 vv(2)=pizda(1,2)+pizda(2,1)
7565 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7566 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7567 C Explicit gradient in virtual-dihedral angles.
7568 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7569 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7570 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7571 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7572 vv(1)=pizda(1,1)-pizda(2,2)
7573 vv(2)=pizda(1,2)+pizda(2,1)
7574 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7575 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7576 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7577 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7578 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7579 vv(1)=pizda(1,1)-pizda(2,2)
7580 vv(2)=pizda(1,2)+pizda(2,1)
7581 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7582 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7583 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7584 C Cartesian gradient
7588 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7590 vv(1)=pizda(1,1)-pizda(2,2)
7591 vv(2)=pizda(1,2)+pizda(2,1)
7592 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7593 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7594 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7599 C Contribution from graph IV
7601 call transpose2(EE(1,1,itl),auxmat(1,1))
7602 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7603 vv(1)=pizda(1,1)+pizda(2,2)
7604 vv(2)=pizda(2,1)-pizda(1,2)
7605 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7606 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7607 C Explicit gradient in virtual-dihedral angles.
7608 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7609 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7610 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7611 vv(1)=pizda(1,1)+pizda(2,2)
7612 vv(2)=pizda(2,1)-pizda(1,2)
7613 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7614 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7615 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7616 C Cartesian gradient
7620 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7622 vv(1)=pizda(1,1)+pizda(2,2)
7623 vv(2)=pizda(2,1)-pizda(1,2)
7624 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7625 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7626 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7631 C Antiparallel orientation
7632 C Contribution from graph III
7634 call transpose2(EUg(1,1,j),auxmat(1,1))
7635 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7636 vv(1)=pizda(1,1)-pizda(2,2)
7637 vv(2)=pizda(1,2)+pizda(2,1)
7638 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7639 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7640 C Explicit gradient in virtual-dihedral angles.
7641 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7642 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7643 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7644 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7645 vv(1)=pizda(1,1)-pizda(2,2)
7646 vv(2)=pizda(1,2)+pizda(2,1)
7647 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7648 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7649 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7650 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7651 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7652 vv(1)=pizda(1,1)-pizda(2,2)
7653 vv(2)=pizda(1,2)+pizda(2,1)
7654 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7655 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7656 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7657 C Cartesian gradient
7661 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7663 vv(1)=pizda(1,1)-pizda(2,2)
7664 vv(2)=pizda(1,2)+pizda(2,1)
7665 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7666 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7667 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7672 C Contribution from graph IV
7674 call transpose2(EE(1,1,itj),auxmat(1,1))
7675 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7676 vv(1)=pizda(1,1)+pizda(2,2)
7677 vv(2)=pizda(2,1)-pizda(1,2)
7678 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7679 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7680 C Explicit gradient in virtual-dihedral angles.
7681 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7682 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7683 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7684 vv(1)=pizda(1,1)+pizda(2,2)
7685 vv(2)=pizda(2,1)-pizda(1,2)
7686 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7687 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7688 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7689 C Cartesian gradient
7693 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7695 vv(1)=pizda(1,1)+pizda(2,2)
7696 vv(2)=pizda(2,1)-pizda(1,2)
7697 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7698 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7699 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7705 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7706 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7707 cd write (2,*) 'ijkl',i,j,k,l
7708 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7709 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7711 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7712 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7713 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7714 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7715 if (j.lt.nres-1) then
7722 if (l.lt.nres-1) then
7732 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7733 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7734 C summed up outside the subrouine as for the other subroutines
7735 C handling long-range interactions. The old code is commented out
7736 C with "cgrad" to keep track of changes.
7738 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7739 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7740 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7741 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7742 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7743 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7744 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7745 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7746 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7747 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7749 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7750 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7751 cgrad ghalf=0.5d0*ggg1(ll)
7753 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7754 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7755 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7756 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7757 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7758 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7759 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7760 cgrad ghalf=0.5d0*ggg2(ll)
7762 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7763 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7764 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7765 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7766 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7767 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7772 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7773 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7778 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7779 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7785 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7790 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7794 cd write (2,*) iii,g_corr5_loc(iii)
7797 cd write (2,*) 'ekont',ekont
7798 cd write (iout,*) 'eello5',ekont*eel5
7801 c--------------------------------------------------------------------------
7802 double precision function eello6(i,j,k,l,jj,kk)
7803 implicit real*8 (a-h,o-z)
7804 include 'DIMENSIONS'
7805 include 'COMMON.IOUNITS'
7806 include 'COMMON.CHAIN'
7807 include 'COMMON.DERIV'
7808 include 'COMMON.INTERACT'
7809 include 'COMMON.CONTACTS'
7810 include 'COMMON.TORSION'
7811 include 'COMMON.VAR'
7812 include 'COMMON.GEO'
7813 include 'COMMON.FFIELD'
7814 double precision ggg1(3),ggg2(3)
7815 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7820 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7828 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7829 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7833 derx(lll,kkk,iii)=0.0d0
7837 cd eij=facont_hb(jj,i)
7838 cd ekl=facont_hb(kk,k)
7844 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7845 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7846 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7847 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7848 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7849 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7851 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7852 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7853 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7854 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7855 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7856 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7860 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7862 C If turn contributions are considered, they will be handled separately.
7863 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7864 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7865 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7866 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7867 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7868 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7869 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7871 if (j.lt.nres-1) then
7878 if (l.lt.nres-1) then
7886 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7887 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7888 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7889 cgrad ghalf=0.5d0*ggg1(ll)
7891 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7892 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7893 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7894 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7895 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7896 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7897 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7898 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7899 cgrad ghalf=0.5d0*ggg2(ll)
7900 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7902 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7903 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7904 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7905 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7906 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7907 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7912 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7913 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7918 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7919 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7925 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7930 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7934 cd write (2,*) iii,g_corr6_loc(iii)
7937 cd write (2,*) 'ekont',ekont
7938 cd write (iout,*) 'eello6',ekont*eel6
7941 c--------------------------------------------------------------------------
7942 double precision function eello6_graph1(i,j,k,l,imat,swap)
7943 implicit real*8 (a-h,o-z)
7944 include 'DIMENSIONS'
7945 include 'COMMON.IOUNITS'
7946 include 'COMMON.CHAIN'
7947 include 'COMMON.DERIV'
7948 include 'COMMON.INTERACT'
7949 include 'COMMON.CONTACTS'
7950 include 'COMMON.TORSION'
7951 include 'COMMON.VAR'
7952 include 'COMMON.GEO'
7953 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7957 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7959 C Parallel Antiparallel C
7965 C \ j|/k\| / \ |/k\|l / C
7970 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7971 itk=itortyp(itype(k))
7972 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7973 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7974 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7975 call transpose2(EUgC(1,1,k),auxmat(1,1))
7976 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7977 vv1(1)=pizda1(1,1)-pizda1(2,2)
7978 vv1(2)=pizda1(1,2)+pizda1(2,1)
7979 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7980 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7981 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7982 s5=scalar2(vv(1),Dtobr2(1,i))
7983 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7984 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7985 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7986 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7987 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7988 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7989 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7990 & +scalar2(vv(1),Dtobr2der(1,i)))
7991 call matmat2(AEAderg(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 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7995 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7997 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7998 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7999 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8000 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8001 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8003 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8004 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8005 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8006 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8007 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8009 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8010 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8011 vv1(1)=pizda1(1,1)-pizda1(2,2)
8012 vv1(2)=pizda1(1,2)+pizda1(2,1)
8013 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8014 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8015 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8016 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8025 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8026 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8027 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8028 call transpose2(EUgC(1,1,k),auxmat(1,1))
8029 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8031 vv1(1)=pizda1(1,1)-pizda1(2,2)
8032 vv1(2)=pizda1(1,2)+pizda1(2,1)
8033 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8034 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8035 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8036 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8037 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8038 s5=scalar2(vv(1),Dtobr2(1,i))
8039 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8045 c----------------------------------------------------------------------------
8046 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8047 implicit real*8 (a-h,o-z)
8048 include 'DIMENSIONS'
8049 include 'COMMON.IOUNITS'
8050 include 'COMMON.CHAIN'
8051 include 'COMMON.DERIV'
8052 include 'COMMON.INTERACT'
8053 include 'COMMON.CONTACTS'
8054 include 'COMMON.TORSION'
8055 include 'COMMON.VAR'
8056 include 'COMMON.GEO'
8058 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8059 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8062 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8064 C Parallel Antiparallel C
8070 C \ j|/k\| \ |/k\|l C
8075 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8076 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8077 C AL 7/4/01 s1 would occur in the sixth-order moment,
8078 C but not in a cluster cumulant
8080 s1=dip(1,jj,i)*dip(1,kk,k)
8082 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8083 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8084 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8085 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8086 call transpose2(EUg(1,1,k),auxmat(1,1))
8087 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8088 vv(1)=pizda(1,1)-pizda(2,2)
8089 vv(2)=pizda(1,2)+pizda(2,1)
8090 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8091 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8093 eello6_graph2=-(s1+s2+s3+s4)
8095 eello6_graph2=-(s2+s3+s4)
8098 C Derivatives in gamma(i-1)
8101 s1=dipderg(1,jj,i)*dip(1,kk,k)
8103 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8104 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8105 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8106 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8108 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8110 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8112 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8114 C Derivatives in gamma(k-1)
8116 s1=dip(1,jj,i)*dipderg(1,kk,k)
8118 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8119 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8120 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8121 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8122 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8123 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8124 vv(1)=pizda(1,1)-pizda(2,2)
8125 vv(2)=pizda(1,2)+pizda(2,1)
8126 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8128 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8130 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8132 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8133 C Derivatives in gamma(j-1) or gamma(l-1)
8136 s1=dipderg(3,jj,i)*dip(1,kk,k)
8138 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8139 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8140 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8141 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8142 vv(1)=pizda(1,1)-pizda(2,2)
8143 vv(2)=pizda(1,2)+pizda(2,1)
8144 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8147 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8149 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8152 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8153 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8155 C Derivatives in gamma(l-1) or gamma(j-1)
8158 s1=dip(1,jj,i)*dipderg(3,kk,k)
8160 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8161 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8162 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8163 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8164 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8165 vv(1)=pizda(1,1)-pizda(2,2)
8166 vv(2)=pizda(1,2)+pizda(2,1)
8167 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8170 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8172 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8175 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8176 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8178 C Cartesian derivatives.
8180 write (2,*) 'In eello6_graph2'
8182 write (2,*) 'iii=',iii
8184 write (2,*) 'kkk=',kkk
8186 write (2,'(3(2f10.5),5x)')
8187 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8197 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8199 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8202 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8204 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8205 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8207 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8208 call transpose2(EUg(1,1,k),auxmat(1,1))
8209 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8211 vv(1)=pizda(1,1)-pizda(2,2)
8212 vv(2)=pizda(1,2)+pizda(2,1)
8213 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8214 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8216 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8218 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8221 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8223 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8230 c----------------------------------------------------------------------------
8231 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8232 implicit real*8 (a-h,o-z)
8233 include 'DIMENSIONS'
8234 include 'COMMON.IOUNITS'
8235 include 'COMMON.CHAIN'
8236 include 'COMMON.DERIV'
8237 include 'COMMON.INTERACT'
8238 include 'COMMON.CONTACTS'
8239 include 'COMMON.TORSION'
8240 include 'COMMON.VAR'
8241 include 'COMMON.GEO'
8242 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8244 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8246 C Parallel Antiparallel C
8252 C j|/k\| / |/k\|l / C
8257 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8259 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8260 C energy moment and not to the cluster cumulant.
8261 iti=itortyp(itype(i))
8262 if (j.lt.nres-1) then
8263 itj1=itortyp(itype(j+1))
8267 itk=itortyp(itype(k))
8268 itk1=itortyp(itype(k+1))
8269 if (l.lt.nres-1) then
8270 itl1=itortyp(itype(l+1))
8275 s1=dip(4,jj,i)*dip(4,kk,k)
8277 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8278 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8279 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8280 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8281 call transpose2(EE(1,1,itk),auxmat(1,1))
8282 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8283 vv(1)=pizda(1,1)+pizda(2,2)
8284 vv(2)=pizda(2,1)-pizda(1,2)
8285 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8286 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8287 cd & "sum",-(s2+s3+s4)
8289 eello6_graph3=-(s1+s2+s3+s4)
8291 eello6_graph3=-(s2+s3+s4)
8294 C Derivatives in gamma(k-1)
8295 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8296 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8297 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8298 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8299 C Derivatives in gamma(l-1)
8300 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8301 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8302 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8303 vv(1)=pizda(1,1)+pizda(2,2)
8304 vv(2)=pizda(2,1)-pizda(1,2)
8305 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8306 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8307 C Cartesian derivatives.
8313 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8315 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8318 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8320 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8321 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8323 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8324 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8326 vv(1)=pizda(1,1)+pizda(2,2)
8327 vv(2)=pizda(2,1)-pizda(1,2)
8328 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8330 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8332 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8335 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8337 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8339 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8345 c----------------------------------------------------------------------------
8346 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8347 implicit real*8 (a-h,o-z)
8348 include 'DIMENSIONS'
8349 include 'COMMON.IOUNITS'
8350 include 'COMMON.CHAIN'
8351 include 'COMMON.DERIV'
8352 include 'COMMON.INTERACT'
8353 include 'COMMON.CONTACTS'
8354 include 'COMMON.TORSION'
8355 include 'COMMON.VAR'
8356 include 'COMMON.GEO'
8357 include 'COMMON.FFIELD'
8358 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8359 & auxvec1(2),auxmat1(2,2)
8361 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8363 C Parallel Antiparallel C
8369 C \ j|/k\| \ |/k\|l C
8374 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8376 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8377 C energy moment and not to the cluster cumulant.
8378 cd write (2,*) 'eello_graph4: wturn6',wturn6
8379 iti=itortyp(itype(i))
8380 itj=itortyp(itype(j))
8381 if (j.lt.nres-1) then
8382 itj1=itortyp(itype(j+1))
8386 itk=itortyp(itype(k))
8387 if (k.lt.nres-1) then
8388 itk1=itortyp(itype(k+1))
8392 itl=itortyp(itype(l))
8393 if (l.lt.nres-1) then
8394 itl1=itortyp(itype(l+1))
8398 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8399 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8400 cd & ' itl',itl,' itl1',itl1
8403 s1=dip(3,jj,i)*dip(3,kk,k)
8405 s1=dip(2,jj,j)*dip(2,kk,l)
8408 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8409 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8411 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8412 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8414 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8415 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8417 call transpose2(EUg(1,1,k),auxmat(1,1))
8418 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8419 vv(1)=pizda(1,1)-pizda(2,2)
8420 vv(2)=pizda(2,1)+pizda(1,2)
8421 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8422 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8424 eello6_graph4=-(s1+s2+s3+s4)
8426 eello6_graph4=-(s2+s3+s4)
8428 C Derivatives in gamma(i-1)
8432 s1=dipderg(2,jj,i)*dip(3,kk,k)
8434 s1=dipderg(4,jj,j)*dip(2,kk,l)
8437 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8439 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8440 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8442 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8443 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8445 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8446 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8447 cd write (2,*) 'turn6 derivatives'
8449 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8451 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8455 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8457 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8461 C Derivatives in gamma(k-1)
8464 s1=dip(3,jj,i)*dipderg(2,kk,k)
8466 s1=dip(2,jj,j)*dipderg(4,kk,l)
8469 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8470 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8472 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8473 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8475 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8476 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8478 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8479 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8480 vv(1)=pizda(1,1)-pizda(2,2)
8481 vv(2)=pizda(2,1)+pizda(1,2)
8482 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8483 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8485 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8487 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8491 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8493 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8496 C Derivatives in gamma(j-1) or gamma(l-1)
8497 if (l.eq.j+1 .and. l.gt.1) then
8498 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8499 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8500 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8501 vv(1)=pizda(1,1)-pizda(2,2)
8502 vv(2)=pizda(2,1)+pizda(1,2)
8503 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8504 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8505 else if (j.gt.1) then
8506 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8507 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8508 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8509 vv(1)=pizda(1,1)-pizda(2,2)
8510 vv(2)=pizda(2,1)+pizda(1,2)
8511 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8512 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8513 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8515 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8518 C Cartesian derivatives.
8525 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8527 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8531 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8533 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8537 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8539 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8541 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8542 & b1(1,itj1),auxvec(1))
8543 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8545 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8546 & b1(1,itl1),auxvec(1))
8547 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8549 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8551 vv(1)=pizda(1,1)-pizda(2,2)
8552 vv(2)=pizda(2,1)+pizda(1,2)
8553 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8555 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8557 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8560 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8563 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8566 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8568 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8570 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8574 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8576 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8579 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8581 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8589 c----------------------------------------------------------------------------
8590 double precision function eello_turn6(i,jj,kk)
8591 implicit real*8 (a-h,o-z)
8592 include 'DIMENSIONS'
8593 include 'COMMON.IOUNITS'
8594 include 'COMMON.CHAIN'
8595 include 'COMMON.DERIV'
8596 include 'COMMON.INTERACT'
8597 include 'COMMON.CONTACTS'
8598 include 'COMMON.TORSION'
8599 include 'COMMON.VAR'
8600 include 'COMMON.GEO'
8601 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8602 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8604 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8605 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8606 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8607 C the respective energy moment and not to the cluster cumulant.
8616 iti=itortyp(itype(i))
8617 itk=itortyp(itype(k))
8618 itk1=itortyp(itype(k+1))
8619 itl=itortyp(itype(l))
8620 itj=itortyp(itype(j))
8621 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8622 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8623 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8628 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8630 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8634 derx_turn(lll,kkk,iii)=0.0d0
8641 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8643 cd write (2,*) 'eello6_5',eello6_5
8645 call transpose2(AEA(1,1,1),auxmat(1,1))
8646 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8647 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8648 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8650 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8651 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8652 s2 = scalar2(b1(1,itk),vtemp1(1))
8654 call transpose2(AEA(1,1,2),atemp(1,1))
8655 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8656 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8657 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8659 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8660 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8661 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8663 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8664 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8665 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8666 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8667 ss13 = scalar2(b1(1,itk),vtemp4(1))
8668 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8670 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8676 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8677 C Derivatives in gamma(i+2)
8681 call transpose2(AEA(1,1,1),auxmatd(1,1))
8682 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8683 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8684 call transpose2(AEAderg(1,1,2),atempd(1,1))
8685 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8686 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8688 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8689 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8690 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8696 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8697 C Derivatives in gamma(i+3)
8699 call transpose2(AEA(1,1,1),auxmatd(1,1))
8700 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8701 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8702 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8704 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8705 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8706 s2d = scalar2(b1(1,itk),vtemp1d(1))
8708 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8709 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8711 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8713 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8714 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8715 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8723 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8724 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8726 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8727 & -0.5d0*ekont*(s2d+s12d)
8729 C Derivatives in gamma(i+4)
8730 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8731 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8732 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8734 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8735 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8736 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8744 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8746 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8748 C Derivatives in gamma(i+5)
8750 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8751 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8752 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8754 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8755 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8756 s2d = scalar2(b1(1,itk),vtemp1d(1))
8758 call transpose2(AEA(1,1,2),atempd(1,1))
8759 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8760 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8762 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8763 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8765 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8766 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8767 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8775 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8776 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8778 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8779 & -0.5d0*ekont*(s2d+s12d)
8781 C Cartesian derivatives
8786 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8787 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8788 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8790 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8791 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8793 s2d = scalar2(b1(1,itk),vtemp1d(1))
8795 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8796 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8797 s8d = -(atempd(1,1)+atempd(2,2))*
8798 & scalar2(cc(1,1,itl),vtemp2(1))
8800 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8802 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8803 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8810 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8813 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8817 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8818 & - 0.5d0*(s8d+s12d)
8820 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8829 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8831 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8832 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8833 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8834 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8835 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8837 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8838 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8839 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8843 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8844 cd & 16*eel_turn6_num
8846 if (j.lt.nres-1) then
8853 if (l.lt.nres-1) then
8861 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8862 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8863 cgrad ghalf=0.5d0*ggg1(ll)
8865 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8866 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8867 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8868 & +ekont*derx_turn(ll,2,1)
8869 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8870 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8871 & +ekont*derx_turn(ll,4,1)
8872 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8873 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8874 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8875 cgrad ghalf=0.5d0*ggg2(ll)
8877 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8878 & +ekont*derx_turn(ll,2,2)
8879 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8880 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8881 & +ekont*derx_turn(ll,4,2)
8882 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8883 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8884 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8889 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8894 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8900 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8905 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8909 cd write (2,*) iii,g_corr6_loc(iii)
8911 eello_turn6=ekont*eel_turn6
8912 cd write (2,*) 'ekont',ekont
8913 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8917 C-----------------------------------------------------------------------------
8918 double precision function scalar(u,v)
8919 !DIR$ INLINEALWAYS scalar
8921 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8924 double precision u(3),v(3)
8925 cd double precision sc
8933 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8936 crc-------------------------------------------------
8937 SUBROUTINE MATVEC2(A1,V1,V2)
8938 !DIR$ INLINEALWAYS MATVEC2
8940 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8942 implicit real*8 (a-h,o-z)
8943 include 'DIMENSIONS'
8944 DIMENSION A1(2,2),V1(2),V2(2)
8948 c 3 VI=VI+A1(I,K)*V1(K)
8952 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8953 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8958 C---------------------------------------
8959 SUBROUTINE MATMAT2(A1,A2,A3)
8961 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8963 implicit real*8 (a-h,o-z)
8964 include 'DIMENSIONS'
8965 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8966 c DIMENSION AI3(2,2)
8970 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8976 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8977 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8978 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8979 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8987 c-------------------------------------------------------------------------
8988 double precision function scalar2(u,v)
8989 !DIR$ INLINEALWAYS scalar2
8991 double precision u(2),v(2)
8994 scalar2=u(1)*v(1)+u(2)*v(2)
8998 C-----------------------------------------------------------------------------
9000 subroutine transpose2(a,at)
9001 !DIR$ INLINEALWAYS transpose2
9003 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9006 double precision a(2,2),at(2,2)
9013 c--------------------------------------------------------------------------
9014 subroutine transpose(n,a,at)
9017 double precision a(n,n),at(n,n)
9025 C---------------------------------------------------------------------------
9026 subroutine prodmat3(a1,a2,kk,transp,prod)
9027 !DIR$ INLINEALWAYS prodmat3
9029 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9033 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9035 crc double precision auxmat(2,2),prod_(2,2)
9038 crc call transpose2(kk(1,1),auxmat(1,1))
9039 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9040 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9042 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9043 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9044 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9045 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9046 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9047 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9048 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9049 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9052 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9053 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9055 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9056 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9057 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9058 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9059 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9060 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9061 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9062 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9065 c call transpose2(a2(1,1),a2t(1,1))
9068 crc print *,((prod_(i,j),i=1,2),j=1,2)
9069 crc print *,((prod(i,j),i=1,2),j=1,2)