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'
1456 itypj=iabs(itype(j))
1457 if (itypj.eq.ntyp1) cycle
1458 c dscj_inv=dsc_inv(itypj)
1459 dscj_inv=vbld_inv(j+nres)
1460 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1461 c & 1.0d0/vbld(j+nres)
1462 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1463 sig0ij=sigma(itypi,itypj)
1464 chi1=chi(itypi,itypj)
1465 chi2=chi(itypj,itypi)
1472 alf12=0.5D0*(alf1+alf2)
1473 C For diagnostics only!!!
1486 dxj=dc_norm(1,nres+j)
1487 dyj=dc_norm(2,nres+j)
1488 dzj=dc_norm(3,nres+j)
1489 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1490 c write (iout,*) "j",j," dc_norm",
1491 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1492 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1494 C Calculate angle-dependent terms of energy and contributions to their
1498 sig=sig0ij*dsqrt(sigsq)
1499 rij_shift=1.0D0/rij-sig+sig0ij
1500 c for diagnostics; uncomment
1501 c rij_shift=1.2*sig0ij
1502 C I hate to put IF's in the loops, but here don't have another choice!!!!
1503 if (rij_shift.le.0.0D0) then
1505 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1506 cd & restyp(itypi),i,restyp(itypj),j,
1507 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1511 c---------------------------------------------------------------
1512 rij_shift=1.0D0/rij_shift
1513 fac=rij_shift**expon
1514 e1=fac*fac*aa(itypi,itypj)
1515 e2=fac*bb(itypi,itypj)
1516 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1517 eps2der=evdwij*eps3rt
1518 eps3der=evdwij*eps2rt
1519 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1520 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1521 evdwij=evdwij*eps2rt*eps3rt
1524 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1525 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1526 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1527 & restyp(itypi),i,restyp(itypj),j,
1528 & epsi,sigm,chi1,chi2,chip1,chip2,
1529 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1530 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1534 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1537 C Calculate gradient components.
1538 e1=e1*eps1*eps2rt**2*eps3rt**2
1539 fac=-expon*(e1+evdwij)*rij_shift
1543 C Calculate the radial part of the gradient
1547 C Calculate angular part of the gradient.
1553 c write (iout,*) "Number of loop steps in EGB:",ind
1554 cccc energy_dec=.false.
1557 C-----------------------------------------------------------------------------
1558 subroutine egbv(evdw)
1560 C This subroutine calculates the interaction energy of nonbonded side chains
1561 C assuming the Gay-Berne-Vorobjev potential of interaction.
1563 implicit real*8 (a-h,o-z)
1564 include 'DIMENSIONS'
1565 include 'COMMON.GEO'
1566 include 'COMMON.VAR'
1567 include 'COMMON.LOCAL'
1568 include 'COMMON.CHAIN'
1569 include 'COMMON.DERIV'
1570 include 'COMMON.NAMES'
1571 include 'COMMON.INTERACT'
1572 include 'COMMON.IOUNITS'
1573 include 'COMMON.CALC'
1574 common /srutu/ icall
1577 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1580 c if (icall.eq.0) lprn=.true.
1582 do i=iatsc_s,iatsc_e
1583 itypi=iabs(itype(i))
1584 if (itypi.eq.ntyp1) cycle
1585 itypi1=iabs(itype(i+1))
1589 dxi=dc_norm(1,nres+i)
1590 dyi=dc_norm(2,nres+i)
1591 dzi=dc_norm(3,nres+i)
1592 c dsci_inv=dsc_inv(itypi)
1593 dsci_inv=vbld_inv(i+nres)
1595 C Calculate SC interaction energy.
1597 do iint=1,nint_gr(i)
1598 do j=istart(i,iint),iend(i,iint)
1600 itypj=iabs(itype(j))
1601 if (itypj.eq.ntyp1) cycle
1602 c dscj_inv=dsc_inv(itypj)
1603 dscj_inv=vbld_inv(j+nres)
1604 sig0ij=sigma(itypi,itypj)
1605 r0ij=r0(itypi,itypj)
1606 chi1=chi(itypi,itypj)
1607 chi2=chi(itypj,itypi)
1614 alf12=0.5D0*(alf1+alf2)
1615 C For diagnostics only!!!
1628 dxj=dc_norm(1,nres+j)
1629 dyj=dc_norm(2,nres+j)
1630 dzj=dc_norm(3,nres+j)
1631 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1633 C Calculate angle-dependent terms of energy and contributions to their
1637 sig=sig0ij*dsqrt(sigsq)
1638 rij_shift=1.0D0/rij-sig+r0ij
1639 C I hate to put IF's in the loops, but here don't have another choice!!!!
1640 if (rij_shift.le.0.0D0) then
1645 c---------------------------------------------------------------
1646 rij_shift=1.0D0/rij_shift
1647 fac=rij_shift**expon
1648 e1=fac*fac*aa(itypi,itypj)
1649 e2=fac*bb(itypi,itypj)
1650 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1651 eps2der=evdwij*eps3rt
1652 eps3der=evdwij*eps2rt
1653 fac_augm=rrij**expon
1654 e_augm=augm(itypi,itypj)*fac_augm
1655 evdwij=evdwij*eps2rt*eps3rt
1656 evdw=evdw+evdwij+e_augm
1658 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1659 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1660 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1661 & restyp(itypi),i,restyp(itypj),j,
1662 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1663 & chi1,chi2,chip1,chip2,
1664 & eps1,eps2rt**2,eps3rt**2,
1665 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1668 C Calculate gradient components.
1669 e1=e1*eps1*eps2rt**2*eps3rt**2
1670 fac=-expon*(e1+evdwij)*rij_shift
1672 fac=rij*fac-2*expon*rrij*e_augm
1673 C Calculate the radial part of the gradient
1677 C Calculate angular part of the gradient.
1683 C-----------------------------------------------------------------------------
1684 subroutine sc_angular
1685 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1686 C om12. Called by ebp, egb, and egbv.
1688 include 'COMMON.CALC'
1689 include 'COMMON.IOUNITS'
1693 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1694 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1695 om12=dxi*dxj+dyi*dyj+dzi*dzj
1697 C Calculate eps1(om12) and its derivative in om12
1698 faceps1=1.0D0-om12*chiom12
1699 faceps1_inv=1.0D0/faceps1
1700 eps1=dsqrt(faceps1_inv)
1701 C Following variable is eps1*deps1/dom12
1702 eps1_om12=faceps1_inv*chiom12
1707 c write (iout,*) "om12",om12," eps1",eps1
1708 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1713 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1714 sigsq=1.0D0-facsig*faceps1_inv
1715 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1716 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1717 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1723 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1724 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1726 C Calculate eps2 and its derivatives in om1, om2, and om12.
1729 chipom12=chip12*om12
1730 facp=1.0D0-om12*chipom12
1732 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1733 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1734 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1735 C Following variable is the square root of eps2
1736 eps2rt=1.0D0-facp1*facp_inv
1737 C Following three variables are the derivatives of the square root of eps
1738 C in om1, om2, and om12.
1739 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1740 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1741 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1742 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1743 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1744 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1745 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1746 c & " eps2rt_om12",eps2rt_om12
1747 C Calculate whole angle-dependent part of epsilon and contributions
1748 C to its derivatives
1751 C----------------------------------------------------------------------------
1753 implicit real*8 (a-h,o-z)
1754 include 'DIMENSIONS'
1755 include 'COMMON.CHAIN'
1756 include 'COMMON.DERIV'
1757 include 'COMMON.CALC'
1758 include 'COMMON.IOUNITS'
1759 double precision dcosom1(3),dcosom2(3)
1760 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1761 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1762 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1763 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1767 c eom12=evdwij*eps1_om12
1769 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1770 c & " sigder",sigder
1771 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1772 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1774 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1775 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1778 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1780 c write (iout,*) "gg",(gg(k),k=1,3)
1782 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1783 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1784 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1785 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1786 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1787 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1788 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1789 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1790 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1791 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1794 C Calculate the components of the gradient in DC and X
1798 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1802 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1803 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1807 C-----------------------------------------------------------------------
1808 subroutine e_softsphere(evdw)
1810 C This subroutine calculates the interaction energy of nonbonded side chains
1811 C assuming the LJ potential of interaction.
1813 implicit real*8 (a-h,o-z)
1814 include 'DIMENSIONS'
1815 parameter (accur=1.0d-10)
1816 include 'COMMON.GEO'
1817 include 'COMMON.VAR'
1818 include 'COMMON.LOCAL'
1819 include 'COMMON.CHAIN'
1820 include 'COMMON.DERIV'
1821 include 'COMMON.INTERACT'
1822 include 'COMMON.TORSION'
1823 include 'COMMON.SBRIDGE'
1824 include 'COMMON.NAMES'
1825 include 'COMMON.IOUNITS'
1826 include 'COMMON.CONTACTS'
1828 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1830 do i=iatsc_s,iatsc_e
1831 itypi=iabs(itype(i))
1832 if (itypi.eq.ntyp1) cycle
1833 itypi1=iabs(itype(i+1))
1838 C Calculate SC interaction energy.
1840 do iint=1,nint_gr(i)
1841 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1842 cd & 'iend=',iend(i,iint)
1843 do j=istart(i,iint),iend(i,iint)
1844 itypj=iabs(itype(j))
1845 if (itypj.eq.ntyp1) cycle
1849 rij=xj*xj+yj*yj+zj*zj
1850 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1851 r0ij=r0(itypi,itypj)
1853 c print *,i,j,r0ij,dsqrt(rij)
1854 if (rij.lt.r0ijsq) then
1855 evdwij=0.25d0*(rij-r0ijsq)**2
1863 C Calculate the components of the gradient in DC and X
1869 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1870 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1871 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1872 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1876 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1884 C--------------------------------------------------------------------------
1885 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1888 C Soft-sphere potential of p-p interaction
1890 implicit real*8 (a-h,o-z)
1891 include 'DIMENSIONS'
1892 include 'COMMON.CONTROL'
1893 include 'COMMON.IOUNITS'
1894 include 'COMMON.GEO'
1895 include 'COMMON.VAR'
1896 include 'COMMON.LOCAL'
1897 include 'COMMON.CHAIN'
1898 include 'COMMON.DERIV'
1899 include 'COMMON.INTERACT'
1900 include 'COMMON.CONTACTS'
1901 include 'COMMON.TORSION'
1902 include 'COMMON.VECTORS'
1903 include 'COMMON.FFIELD'
1905 cd write(iout,*) 'In EELEC_soft_sphere'
1912 do i=iatel_s,iatel_e
1913 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1917 xmedi=c(1,i)+0.5d0*dxi
1918 ymedi=c(2,i)+0.5d0*dyi
1919 zmedi=c(3,i)+0.5d0*dzi
1921 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1922 do j=ielstart(i),ielend(i)
1923 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1927 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1928 r0ij=rpp(iteli,itelj)
1933 xj=c(1,j)+0.5D0*dxj-xmedi
1934 yj=c(2,j)+0.5D0*dyj-ymedi
1935 zj=c(3,j)+0.5D0*dzj-zmedi
1936 rij=xj*xj+yj*yj+zj*zj
1937 if (rij.lt.r0ijsq) then
1938 evdw1ij=0.25d0*(rij-r0ijsq)**2
1946 C Calculate contributions to the Cartesian gradient.
1952 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1953 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1956 * Loop over residues i+1 thru j-1.
1960 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
1965 cgrad do i=nnt,nct-1
1967 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1969 cgrad do j=i+1,nct-1
1971 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
1977 c------------------------------------------------------------------------------
1978 subroutine vec_and_deriv
1979 implicit real*8 (a-h,o-z)
1980 include 'DIMENSIONS'
1984 include 'COMMON.IOUNITS'
1985 include 'COMMON.GEO'
1986 include 'COMMON.VAR'
1987 include 'COMMON.LOCAL'
1988 include 'COMMON.CHAIN'
1989 include 'COMMON.VECTORS'
1990 include 'COMMON.SETUP'
1991 include 'COMMON.TIME1'
1992 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1993 C Compute the local reference systems. For reference system (i), the
1994 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1995 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1997 do i=ivec_start,ivec_end
2001 if (i.eq.nres-1) then
2002 C Case of the last full residue
2003 C Compute the Z-axis
2004 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2005 costh=dcos(pi-theta(nres))
2006 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2010 C Compute the derivatives of uz
2012 uzder(2,1,1)=-dc_norm(3,i-1)
2013 uzder(3,1,1)= dc_norm(2,i-1)
2014 uzder(1,2,1)= dc_norm(3,i-1)
2016 uzder(3,2,1)=-dc_norm(1,i-1)
2017 uzder(1,3,1)=-dc_norm(2,i-1)
2018 uzder(2,3,1)= dc_norm(1,i-1)
2021 uzder(2,1,2)= dc_norm(3,i)
2022 uzder(3,1,2)=-dc_norm(2,i)
2023 uzder(1,2,2)=-dc_norm(3,i)
2025 uzder(3,2,2)= dc_norm(1,i)
2026 uzder(1,3,2)= dc_norm(2,i)
2027 uzder(2,3,2)=-dc_norm(1,i)
2029 C Compute the Y-axis
2032 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2034 C Compute the derivatives of uy
2037 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2038 & -dc_norm(k,i)*dc_norm(j,i-1)
2039 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2041 uyder(j,j,1)=uyder(j,j,1)-costh
2042 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2047 uygrad(l,k,j,i)=uyder(l,k,j)
2048 uzgrad(l,k,j,i)=uzder(l,k,j)
2052 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2053 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2054 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2055 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2058 C Compute the Z-axis
2059 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2060 costh=dcos(pi-theta(i+2))
2061 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2065 C Compute the derivatives of uz
2067 uzder(2,1,1)=-dc_norm(3,i+1)
2068 uzder(3,1,1)= dc_norm(2,i+1)
2069 uzder(1,2,1)= dc_norm(3,i+1)
2071 uzder(3,2,1)=-dc_norm(1,i+1)
2072 uzder(1,3,1)=-dc_norm(2,i+1)
2073 uzder(2,3,1)= dc_norm(1,i+1)
2076 uzder(2,1,2)= dc_norm(3,i)
2077 uzder(3,1,2)=-dc_norm(2,i)
2078 uzder(1,2,2)=-dc_norm(3,i)
2080 uzder(3,2,2)= dc_norm(1,i)
2081 uzder(1,3,2)= dc_norm(2,i)
2082 uzder(2,3,2)=-dc_norm(1,i)
2084 C Compute the Y-axis
2087 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2089 C Compute the derivatives of uy
2092 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2093 & -dc_norm(k,i)*dc_norm(j,i+1)
2094 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2096 uyder(j,j,1)=uyder(j,j,1)-costh
2097 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2102 uygrad(l,k,j,i)=uyder(l,k,j)
2103 uzgrad(l,k,j,i)=uzder(l,k,j)
2107 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2108 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2109 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2110 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2114 vbld_inv_temp(1)=vbld_inv(i+1)
2115 if (i.lt.nres-1) then
2116 vbld_inv_temp(2)=vbld_inv(i+2)
2118 vbld_inv_temp(2)=vbld_inv(i)
2123 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2124 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2129 #if defined(PARVEC) && defined(MPI)
2130 if (nfgtasks1.gt.1) then
2132 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2133 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2134 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2135 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2136 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2138 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2139 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2141 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2142 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2143 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2144 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2145 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2146 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2147 time_gather=time_gather+MPI_Wtime()-time00
2149 c if (fg_rank.eq.0) then
2150 c write (iout,*) "Arrays UY and UZ"
2152 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2159 C-----------------------------------------------------------------------------
2160 subroutine check_vecgrad
2161 implicit real*8 (a-h,o-z)
2162 include 'DIMENSIONS'
2163 include 'COMMON.IOUNITS'
2164 include 'COMMON.GEO'
2165 include 'COMMON.VAR'
2166 include 'COMMON.LOCAL'
2167 include 'COMMON.CHAIN'
2168 include 'COMMON.VECTORS'
2169 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2170 dimension uyt(3,maxres),uzt(3,maxres)
2171 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2172 double precision delta /1.0d-7/
2175 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2176 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2177 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2178 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2179 cd & (dc_norm(if90,i),if90=1,3)
2180 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2181 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2182 cd write(iout,'(a)')
2188 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2189 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2202 cd write (iout,*) 'i=',i
2204 erij(k)=dc_norm(k,i)
2208 dc_norm(k,i)=erij(k)
2210 dc_norm(j,i)=dc_norm(j,i)+delta
2211 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2213 c dc_norm(k,i)=dc_norm(k,i)/fac
2215 c write (iout,*) (dc_norm(k,i),k=1,3)
2216 c write (iout,*) (erij(k),k=1,3)
2219 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2220 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2221 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2222 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2224 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2225 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2226 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2229 dc_norm(k,i)=erij(k)
2232 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2233 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2234 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2235 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2236 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2237 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2238 cd write (iout,'(a)')
2243 C--------------------------------------------------------------------------
2244 subroutine set_matrices
2245 implicit real*8 (a-h,o-z)
2246 include 'DIMENSIONS'
2249 include "COMMON.SETUP"
2251 integer status(MPI_STATUS_SIZE)
2253 include 'COMMON.IOUNITS'
2254 include 'COMMON.GEO'
2255 include 'COMMON.VAR'
2256 include 'COMMON.LOCAL'
2257 include 'COMMON.CHAIN'
2258 include 'COMMON.DERIV'
2259 include 'COMMON.INTERACT'
2260 include 'COMMON.CONTACTS'
2261 include 'COMMON.TORSION'
2262 include 'COMMON.VECTORS'
2263 include 'COMMON.FFIELD'
2264 double precision auxvec(2),auxmat(2,2)
2266 C Compute the virtual-bond-torsional-angle dependent quantities needed
2267 C to calculate the el-loc multibody terms of various order.
2270 do i=ivec_start+2,ivec_end+2
2274 if (i .lt. nres+1) then
2311 if (i .gt. 3 .and. i .lt. nres+1) then
2312 obrot_der(1,i-2)=-sin1
2313 obrot_der(2,i-2)= cos1
2314 Ugder(1,1,i-2)= sin1
2315 Ugder(1,2,i-2)=-cos1
2316 Ugder(2,1,i-2)=-cos1
2317 Ugder(2,2,i-2)=-sin1
2320 obrot2_der(1,i-2)=-dwasin2
2321 obrot2_der(2,i-2)= dwacos2
2322 Ug2der(1,1,i-2)= dwasin2
2323 Ug2der(1,2,i-2)=-dwacos2
2324 Ug2der(2,1,i-2)=-dwacos2
2325 Ug2der(2,2,i-2)=-dwasin2
2327 obrot_der(1,i-2)=0.0d0
2328 obrot_der(2,i-2)=0.0d0
2329 Ugder(1,1,i-2)=0.0d0
2330 Ugder(1,2,i-2)=0.0d0
2331 Ugder(2,1,i-2)=0.0d0
2332 Ugder(2,2,i-2)=0.0d0
2333 obrot2_der(1,i-2)=0.0d0
2334 obrot2_der(2,i-2)=0.0d0
2335 Ug2der(1,1,i-2)=0.0d0
2336 Ug2der(1,2,i-2)=0.0d0
2337 Ug2der(2,1,i-2)=0.0d0
2338 Ug2der(2,2,i-2)=0.0d0
2340 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2341 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2342 iti = itortyp(itype(i-2))
2346 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2347 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2348 iti1 = itortyp(itype(i-1))
2352 cd write (iout,*) '*******i',i,' iti1',iti
2353 cd write (iout,*) 'b1',b1(:,iti)
2354 cd write (iout,*) 'b2',b2(:,iti)
2355 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2356 c if (i .gt. iatel_s+2) then
2357 if (i .gt. nnt+2) then
2358 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2359 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2360 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2362 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2363 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2364 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2365 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2366 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2377 DtUg2(l,k,i-2)=0.0d0
2381 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2382 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2384 muder(k,i-2)=Ub2der(k,i-2)
2386 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2387 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2388 if (itype(i-1).le.ntyp) then
2389 iti1 = itortyp(itype(i-1))
2397 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2399 cd write (iout,*) 'mu ',mu(:,i-2)
2400 cd write (iout,*) 'mu1',mu1(:,i-2)
2401 cd write (iout,*) 'mu2',mu2(:,i-2)
2402 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2404 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2405 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2406 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2407 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2408 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2409 C Vectors and matrices dependent on a single virtual-bond dihedral.
2410 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2411 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2412 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2413 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2414 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2415 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2416 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2417 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2418 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2421 C Matrices dependent on two consecutive virtual-bond dihedrals.
2422 C The order of matrices is from left to right.
2423 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2425 c do i=max0(ivec_start,2),ivec_end
2427 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2428 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2429 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2430 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2431 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2432 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2433 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2434 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2437 #if defined(MPI) && defined(PARMAT)
2439 c if (fg_rank.eq.0) then
2440 write (iout,*) "Arrays UG and UGDER before GATHER"
2442 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2443 & ((ug(l,k,i),l=1,2),k=1,2),
2444 & ((ugder(l,k,i),l=1,2),k=1,2)
2446 write (iout,*) "Arrays UG2 and UG2DER"
2448 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2449 & ((ug2(l,k,i),l=1,2),k=1,2),
2450 & ((ug2der(l,k,i),l=1,2),k=1,2)
2452 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2454 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2455 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2456 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2458 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2460 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2461 & costab(i),sintab(i),costab2(i),sintab2(i)
2463 write (iout,*) "Array MUDER"
2465 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2469 if (nfgtasks.gt.1) then
2471 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2472 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2473 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2475 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2476 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2478 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2479 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2481 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2482 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2484 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2485 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2487 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2488 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2490 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2491 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2493 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2494 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2495 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2496 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2497 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2498 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2499 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2500 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2501 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2502 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2503 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2504 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2505 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2507 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2508 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2510 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2511 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2513 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2514 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2516 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2517 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2519 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2520 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2522 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2523 & ivec_count(fg_rank1),
2524 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2526 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2527 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2529 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2530 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2532 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2533 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2535 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2536 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2538 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2539 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2541 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2542 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2544 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2545 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2547 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2548 & ivec_count(fg_rank1),
2549 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2551 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2552 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2554 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2555 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2557 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2558 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2560 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2561 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2563 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2564 & ivec_count(fg_rank1),
2565 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2567 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2568 & ivec_count(fg_rank1),
2569 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2571 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2572 & ivec_count(fg_rank1),
2573 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2574 & MPI_MAT2,FG_COMM1,IERR)
2575 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2576 & ivec_count(fg_rank1),
2577 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2578 & MPI_MAT2,FG_COMM1,IERR)
2581 c Passes matrix info through the ring
2584 if (irecv.lt.0) irecv=nfgtasks1-1
2587 if (inext.ge.nfgtasks1) inext=0
2589 c write (iout,*) "isend",isend," irecv",irecv
2591 lensend=lentyp(isend)
2592 lenrecv=lentyp(irecv)
2593 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2594 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2595 c & MPI_ROTAT1(lensend),inext,2200+isend,
2596 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2597 c & iprev,2200+irecv,FG_COMM,status,IERR)
2598 c write (iout,*) "Gather ROTAT1"
2600 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2601 c & MPI_ROTAT2(lensend),inext,3300+isend,
2602 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2603 c & iprev,3300+irecv,FG_COMM,status,IERR)
2604 c write (iout,*) "Gather ROTAT2"
2606 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2607 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2608 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2609 & iprev,4400+irecv,FG_COMM,status,IERR)
2610 c write (iout,*) "Gather ROTAT_OLD"
2612 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2613 & MPI_PRECOMP11(lensend),inext,5500+isend,
2614 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2615 & iprev,5500+irecv,FG_COMM,status,IERR)
2616 c write (iout,*) "Gather PRECOMP11"
2618 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2619 & MPI_PRECOMP12(lensend),inext,6600+isend,
2620 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2621 & iprev,6600+irecv,FG_COMM,status,IERR)
2622 c write (iout,*) "Gather PRECOMP12"
2624 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2626 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2627 & MPI_ROTAT2(lensend),inext,7700+isend,
2628 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2629 & iprev,7700+irecv,FG_COMM,status,IERR)
2630 c write (iout,*) "Gather PRECOMP21"
2632 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2633 & MPI_PRECOMP22(lensend),inext,8800+isend,
2634 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2635 & iprev,8800+irecv,FG_COMM,status,IERR)
2636 c write (iout,*) "Gather PRECOMP22"
2638 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2639 & MPI_PRECOMP23(lensend),inext,9900+isend,
2640 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2641 & MPI_PRECOMP23(lenrecv),
2642 & iprev,9900+irecv,FG_COMM,status,IERR)
2643 c write (iout,*) "Gather PRECOMP23"
2648 if (irecv.lt.0) irecv=nfgtasks1-1
2651 time_gather=time_gather+MPI_Wtime()-time00
2654 c if (fg_rank.eq.0) then
2655 write (iout,*) "Arrays UG and UGDER"
2657 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2658 & ((ug(l,k,i),l=1,2),k=1,2),
2659 & ((ugder(l,k,i),l=1,2),k=1,2)
2661 write (iout,*) "Arrays UG2 and UG2DER"
2663 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2664 & ((ug2(l,k,i),l=1,2),k=1,2),
2665 & ((ug2der(l,k,i),l=1,2),k=1,2)
2667 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2669 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2670 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2671 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2673 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2675 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2676 & costab(i),sintab(i),costab2(i),sintab2(i)
2678 write (iout,*) "Array MUDER"
2680 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2686 cd iti = itortyp(itype(i))
2689 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2690 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2695 C--------------------------------------------------------------------------
2696 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2698 C This subroutine calculates the average interaction energy and its gradient
2699 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2700 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2701 C The potential depends both on the distance of peptide-group centers and on
2702 C the orientation of the CA-CA virtual bonds.
2704 implicit real*8 (a-h,o-z)
2708 include 'DIMENSIONS'
2709 include 'COMMON.CONTROL'
2710 include 'COMMON.SETUP'
2711 include 'COMMON.IOUNITS'
2712 include 'COMMON.GEO'
2713 include 'COMMON.VAR'
2714 include 'COMMON.LOCAL'
2715 include 'COMMON.CHAIN'
2716 include 'COMMON.DERIV'
2717 include 'COMMON.INTERACT'
2718 include 'COMMON.CONTACTS'
2719 include 'COMMON.TORSION'
2720 include 'COMMON.VECTORS'
2721 include 'COMMON.FFIELD'
2722 include 'COMMON.TIME1'
2723 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2724 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2725 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2726 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2727 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2728 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2730 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2732 double precision scal_el /1.0d0/
2734 double precision scal_el /0.5d0/
2737 C 13-go grudnia roku pamietnego...
2738 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2739 & 0.0d0,1.0d0,0.0d0,
2740 & 0.0d0,0.0d0,1.0d0/
2741 cd write(iout,*) 'In EELEC'
2743 cd write(iout,*) 'Type',i
2744 cd write(iout,*) 'B1',B1(:,i)
2745 cd write(iout,*) 'B2',B2(:,i)
2746 cd write(iout,*) 'CC',CC(:,:,i)
2747 cd write(iout,*) 'DD',DD(:,:,i)
2748 cd write(iout,*) 'EE',EE(:,:,i)
2750 cd call check_vecgrad
2752 if (icheckgrad.eq.1) then
2754 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2756 dc_norm(k,i)=dc(k,i)*fac
2758 c write (iout,*) 'i',i,' fac',fac
2761 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2762 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2763 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2764 c call vec_and_deriv
2770 time_mat=time_mat+MPI_Wtime()-time01
2774 cd write (iout,*) 'i=',i
2776 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2779 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2780 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2793 cd print '(a)','Enter EELEC'
2794 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2796 gel_loc_loc(i)=0.0d0
2801 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2803 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2805 do i=iturn3_start,iturn3_end
2806 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2807 & .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
2811 dx_normi=dc_norm(1,i)
2812 dy_normi=dc_norm(2,i)
2813 dz_normi=dc_norm(3,i)
2814 xmedi=c(1,i)+0.5d0*dxi
2815 ymedi=c(2,i)+0.5d0*dyi
2816 zmedi=c(3,i)+0.5d0*dzi
2818 call eelecij(i,i+2,ees,evdw1,eel_loc)
2819 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2820 num_cont_hb(i)=num_conti
2822 do i=iturn4_start,iturn4_end
2823 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2824 & .or. itype(i+3).eq.ntyp1
2825 & .or. itype(i+4).eq.ntyp1) cycle
2829 dx_normi=dc_norm(1,i)
2830 dy_normi=dc_norm(2,i)
2831 dz_normi=dc_norm(3,i)
2832 xmedi=c(1,i)+0.5d0*dxi
2833 ymedi=c(2,i)+0.5d0*dyi
2834 zmedi=c(3,i)+0.5d0*dzi
2835 num_conti=num_cont_hb(i)
2836 call eelecij(i,i+3,ees,evdw1,eel_loc)
2837 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2838 & call eturn4(i,eello_turn4)
2839 num_cont_hb(i)=num_conti
2842 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2844 do i=iatel_s,iatel_e
2845 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2849 dx_normi=dc_norm(1,i)
2850 dy_normi=dc_norm(2,i)
2851 dz_normi=dc_norm(3,i)
2852 xmedi=c(1,i)+0.5d0*dxi
2853 ymedi=c(2,i)+0.5d0*dyi
2854 zmedi=c(3,i)+0.5d0*dzi
2855 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2856 num_conti=num_cont_hb(i)
2857 do j=ielstart(i),ielend(i)
2858 c write (iout,*) i,j,itype(i),itype(j)
2859 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2860 call eelecij(i,j,ees,evdw1,eel_loc)
2862 num_cont_hb(i)=num_conti
2864 c write (iout,*) "Number of loop steps in EELEC:",ind
2866 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2867 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2869 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2870 ccc eel_loc=eel_loc+eello_turn3
2871 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2874 C-------------------------------------------------------------------------------
2875 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2876 implicit real*8 (a-h,o-z)
2877 include 'DIMENSIONS'
2881 include 'COMMON.CONTROL'
2882 include 'COMMON.IOUNITS'
2883 include 'COMMON.GEO'
2884 include 'COMMON.VAR'
2885 include 'COMMON.LOCAL'
2886 include 'COMMON.CHAIN'
2887 include 'COMMON.DERIV'
2888 include 'COMMON.INTERACT'
2889 include 'COMMON.CONTACTS'
2890 include 'COMMON.TORSION'
2891 include 'COMMON.VECTORS'
2892 include 'COMMON.FFIELD'
2893 include 'COMMON.TIME1'
2894 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2895 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2896 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2897 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2898 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2899 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2901 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2903 double precision scal_el /1.0d0/
2905 double precision scal_el /0.5d0/
2908 C 13-go grudnia roku pamietnego...
2909 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2910 & 0.0d0,1.0d0,0.0d0,
2911 & 0.0d0,0.0d0,1.0d0/
2912 c time00=MPI_Wtime()
2913 cd write (iout,*) "eelecij",i,j
2917 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2918 aaa=app(iteli,itelj)
2919 bbb=bpp(iteli,itelj)
2920 ael6i=ael6(iteli,itelj)
2921 ael3i=ael3(iteli,itelj)
2925 dx_normj=dc_norm(1,j)
2926 dy_normj=dc_norm(2,j)
2927 dz_normj=dc_norm(3,j)
2928 xj=c(1,j)+0.5D0*dxj-xmedi
2929 yj=c(2,j)+0.5D0*dyj-ymedi
2930 zj=c(3,j)+0.5D0*dzj-zmedi
2931 rij=xj*xj+yj*yj+zj*zj
2937 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2938 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2939 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2940 fac=cosa-3.0D0*cosb*cosg
2942 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2943 if (j.eq.i+2) ev1=scal_el*ev1
2948 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2951 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2952 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2955 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2956 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2957 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2958 cd & xmedi,ymedi,zmedi,xj,yj,zj
2960 if (energy_dec) then
2961 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
2963 &,iteli,itelj,aaa,evdw1
2964 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2968 C Calculate contributions to the Cartesian gradient.
2971 facvdw=-6*rrmij*(ev1+evdwij)
2972 facel=-3*rrmij*(el1+eesij)
2978 * Radial derivatives. First process both termini of the fragment (i,j)
2984 c ghalf=0.5D0*ggg(k)
2985 c gelc(k,i)=gelc(k,i)+ghalf
2986 c gelc(k,j)=gelc(k,j)+ghalf
2988 c 9/28/08 AL Gradient compotents will be summed only at the end
2990 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2991 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2994 * Loop over residues i+1 thru j-1.
2998 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3005 c ghalf=0.5D0*ggg(k)
3006 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3007 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3009 c 9/28/08 AL Gradient compotents will be summed only at the end
3011 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3012 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3015 * Loop over residues i+1 thru j-1.
3019 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3026 fac=-3*rrmij*(facvdw+facvdw+facel)
3031 * Radial derivatives. First process both termini of the fragment (i,j)
3037 c ghalf=0.5D0*ggg(k)
3038 c gelc(k,i)=gelc(k,i)+ghalf
3039 c gelc(k,j)=gelc(k,j)+ghalf
3041 c 9/28/08 AL Gradient compotents will be summed only at the end
3043 gelc_long(k,j)=gelc(k,j)+ggg(k)
3044 gelc_long(k,i)=gelc(k,i)-ggg(k)
3047 * Loop over residues i+1 thru j-1.
3051 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3054 c 9/28/08 AL Gradient compotents will be summed only at the end
3059 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3060 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3066 ecosa=2.0D0*fac3*fac1+fac4
3069 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3070 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3072 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3073 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3075 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3076 cd & (dcosg(k),k=1,3)
3078 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3081 c ghalf=0.5D0*ggg(k)
3082 c gelc(k,i)=gelc(k,i)+ghalf
3083 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3084 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3085 c gelc(k,j)=gelc(k,j)+ghalf
3086 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3087 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3091 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3096 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3097 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3099 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3100 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3101 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3102 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3104 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3105 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3106 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3108 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3109 C energy of a peptide unit is assumed in the form of a second-order
3110 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3111 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3112 C are computed for EVERY pair of non-contiguous peptide groups.
3114 if (j.lt.nres-1) then
3125 muij(kkk)=mu(k,i)*mu(l,j)
3128 cd write (iout,*) 'EELEC: i',i,' j',j
3129 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3130 cd write(iout,*) 'muij',muij
3131 ury=scalar(uy(1,i),erij)
3132 urz=scalar(uz(1,i),erij)
3133 vry=scalar(uy(1,j),erij)
3134 vrz=scalar(uz(1,j),erij)
3135 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3136 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3137 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3138 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3139 fac=dsqrt(-ael6i)*r3ij
3144 cd write (iout,'(4i5,4f10.5)')
3145 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3146 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3147 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3148 cd & uy(:,j),uz(:,j)
3149 cd write (iout,'(4f10.5)')
3150 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3151 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3152 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3153 cd write (iout,'(9f10.5/)')
3154 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3155 C Derivatives of the elements of A in virtual-bond vectors
3156 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3158 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3159 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3160 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3161 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3162 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3163 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3164 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3165 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3166 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3167 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3168 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3169 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3171 C Compute radial contributions to the gradient
3189 C Add the contributions coming from er
3192 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3193 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3194 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3195 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3198 C Derivatives in DC(i)
3199 cgrad ghalf1=0.5d0*agg(k,1)
3200 cgrad ghalf2=0.5d0*agg(k,2)
3201 cgrad ghalf3=0.5d0*agg(k,3)
3202 cgrad ghalf4=0.5d0*agg(k,4)
3203 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3204 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3205 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3206 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3207 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3208 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3209 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3210 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3211 C Derivatives in DC(i+1)
3212 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3213 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3214 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3215 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3216 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3217 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3218 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3219 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3220 C Derivatives in DC(j)
3221 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3222 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3223 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3224 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3225 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3226 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3227 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3228 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3229 C Derivatives in DC(j+1) or DC(nres-1)
3230 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3231 & -3.0d0*vryg(k,3)*ury)
3232 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3233 & -3.0d0*vrzg(k,3)*ury)
3234 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3235 & -3.0d0*vryg(k,3)*urz)
3236 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3237 & -3.0d0*vrzg(k,3)*urz)
3238 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3240 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3253 aggi(k,l)=-aggi(k,l)
3254 aggi1(k,l)=-aggi1(k,l)
3255 aggj(k,l)=-aggj(k,l)
3256 aggj1(k,l)=-aggj1(k,l)
3259 if (j.lt.nres-1) then
3265 aggi(k,l)=-aggi(k,l)
3266 aggi1(k,l)=-aggi1(k,l)
3267 aggj(k,l)=-aggj(k,l)
3268 aggj1(k,l)=-aggj1(k,l)
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)
3287 IF (wel_loc.gt.0.0d0) THEN
3288 C Contribution to the local-electrostatic energy coming from the i-j pair
3289 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3291 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3293 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3294 & 'eelloc',i,j,eel_loc_ij
3295 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3297 eel_loc=eel_loc+eel_loc_ij
3298 C Partial derivatives in virtual-bond dihedral angles gamma
3300 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3301 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3302 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3303 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3304 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3305 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3306 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3308 ggg(l)=agg(l,1)*muij(1)+
3309 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3310 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3311 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3312 cgrad ghalf=0.5d0*ggg(l)
3313 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3314 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3318 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3321 C Remaining derivatives of eello
3323 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3324 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3325 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3326 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3327 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3328 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3329 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3330 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3333 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3334 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3335 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3336 & .and. num_conti.le.maxconts) then
3337 c write (iout,*) i,j," entered corr"
3339 C Calculate the contact function. The ith column of the array JCONT will
3340 C contain the numbers of atoms that make contacts with the atom I (of numbers
3341 C greater than I). The arrays FACONT and GACONT will contain the values of
3342 C the contact function and its derivative.
3343 c r0ij=1.02D0*rpp(iteli,itelj)
3344 c r0ij=1.11D0*rpp(iteli,itelj)
3345 r0ij=2.20D0*rpp(iteli,itelj)
3346 c r0ij=1.55D0*rpp(iteli,itelj)
3347 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3348 if (fcont.gt.0.0D0) then
3349 num_conti=num_conti+1
3350 if (num_conti.gt.maxconts) then
3351 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3352 & ' will skip next contacts for this conf.'
3354 jcont_hb(num_conti,i)=j
3355 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3356 cd & " jcont_hb",jcont_hb(num_conti,i)
3357 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3358 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3359 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3361 d_cont(num_conti,i)=rij
3362 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3363 C --- Electrostatic-interaction matrix ---
3364 a_chuj(1,1,num_conti,i)=a22
3365 a_chuj(1,2,num_conti,i)=a23
3366 a_chuj(2,1,num_conti,i)=a32
3367 a_chuj(2,2,num_conti,i)=a33
3368 C --- Gradient of rij
3370 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3377 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3378 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3379 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3380 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3381 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3386 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3387 C Calculate contact energies
3389 wij=cosa-3.0D0*cosb*cosg
3392 c fac3=dsqrt(-ael6i)/r0ij**3
3393 fac3=dsqrt(-ael6i)*r3ij
3394 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3395 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3396 if (ees0tmp.gt.0) then
3397 ees0pij=dsqrt(ees0tmp)
3401 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3402 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3403 if (ees0tmp.gt.0) then
3404 ees0mij=dsqrt(ees0tmp)
3409 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3410 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3411 C Diagnostics. Comment out or remove after debugging!
3412 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3413 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3414 c ees0m(num_conti,i)=0.0D0
3416 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3417 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3418 C Angular derivatives of the contact function
3419 ees0pij1=fac3/ees0pij
3420 ees0mij1=fac3/ees0mij
3421 fac3p=-3.0D0*fac3*rrmij
3422 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3423 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3425 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3426 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3427 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3428 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3429 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3430 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3431 ecosap=ecosa1+ecosa2
3432 ecosbp=ecosb1+ecosb2
3433 ecosgp=ecosg1+ecosg2
3434 ecosam=ecosa1-ecosa2
3435 ecosbm=ecosb1-ecosb2
3436 ecosgm=ecosg1-ecosg2
3445 facont_hb(num_conti,i)=fcont
3446 fprimcont=fprimcont/rij
3447 cd facont_hb(num_conti,i)=1.0D0
3448 C Following line is for diagnostics.
3451 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3452 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3455 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3456 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3458 gggp(1)=gggp(1)+ees0pijp*xj
3459 gggp(2)=gggp(2)+ees0pijp*yj
3460 gggp(3)=gggp(3)+ees0pijp*zj
3461 gggm(1)=gggm(1)+ees0mijp*xj
3462 gggm(2)=gggm(2)+ees0mijp*yj
3463 gggm(3)=gggm(3)+ees0mijp*zj
3464 C Derivatives due to the contact function
3465 gacont_hbr(1,num_conti,i)=fprimcont*xj
3466 gacont_hbr(2,num_conti,i)=fprimcont*yj
3467 gacont_hbr(3,num_conti,i)=fprimcont*zj
3470 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3471 c following the change of gradient-summation algorithm.
3473 cgrad ghalfp=0.5D0*gggp(k)
3474 cgrad ghalfm=0.5D0*gggm(k)
3475 gacontp_hb1(k,num_conti,i)=!ghalfp
3476 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3477 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3478 gacontp_hb2(k,num_conti,i)=!ghalfp
3479 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3480 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3481 gacontp_hb3(k,num_conti,i)=gggp(k)
3482 gacontm_hb1(k,num_conti,i)=!ghalfm
3483 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3484 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3485 gacontm_hb2(k,num_conti,i)=!ghalfm
3486 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3487 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3488 gacontm_hb3(k,num_conti,i)=gggm(k)
3490 C Diagnostics. Comment out or remove after debugging!
3492 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3493 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3494 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3495 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3496 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3497 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3500 endif ! num_conti.le.maxconts
3503 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3506 ghalf=0.5d0*agg(l,k)
3507 aggi(l,k)=aggi(l,k)+ghalf
3508 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3509 aggj(l,k)=aggj(l,k)+ghalf
3512 if (j.eq.nres-1 .and. i.lt.j-2) then
3515 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3520 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3523 C-----------------------------------------------------------------------------
3524 subroutine eturn3(i,eello_turn3)
3525 C Third- and fourth-order contributions from turns
3526 implicit real*8 (a-h,o-z)
3527 include 'DIMENSIONS'
3528 include 'COMMON.IOUNITS'
3529 include 'COMMON.GEO'
3530 include 'COMMON.VAR'
3531 include 'COMMON.LOCAL'
3532 include 'COMMON.CHAIN'
3533 include 'COMMON.DERIV'
3534 include 'COMMON.INTERACT'
3535 include 'COMMON.CONTACTS'
3536 include 'COMMON.TORSION'
3537 include 'COMMON.VECTORS'
3538 include 'COMMON.FFIELD'
3539 include 'COMMON.CONTROL'
3541 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3542 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3543 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3544 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3545 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3546 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3547 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3550 c write (iout,*) "eturn3",i,j,j1,j2
3555 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3557 C Third-order contributions
3564 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3565 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3566 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3567 call transpose2(auxmat(1,1),auxmat1(1,1))
3568 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3569 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3570 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3571 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3572 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3573 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3574 cd & ' eello_turn3_num',4*eello_turn3_num
3575 C Derivatives in gamma(i)
3576 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3577 call transpose2(auxmat2(1,1),auxmat3(1,1))
3578 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3579 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3580 C Derivatives in gamma(i+1)
3581 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3582 call transpose2(auxmat2(1,1),auxmat3(1,1))
3583 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3584 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3585 & +0.5d0*(pizda(1,1)+pizda(2,2))
3586 C Cartesian derivatives
3588 c ghalf1=0.5d0*agg(l,1)
3589 c ghalf2=0.5d0*agg(l,2)
3590 c ghalf3=0.5d0*agg(l,3)
3591 c ghalf4=0.5d0*agg(l,4)
3592 a_temp(1,1)=aggi(l,1)!+ghalf1
3593 a_temp(1,2)=aggi(l,2)!+ghalf2
3594 a_temp(2,1)=aggi(l,3)!+ghalf3
3595 a_temp(2,2)=aggi(l,4)!+ghalf4
3596 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3597 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3598 & +0.5d0*(pizda(1,1)+pizda(2,2))
3599 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3600 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3601 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3602 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3603 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3604 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3605 & +0.5d0*(pizda(1,1)+pizda(2,2))
3606 a_temp(1,1)=aggj(l,1)!+ghalf1
3607 a_temp(1,2)=aggj(l,2)!+ghalf2
3608 a_temp(2,1)=aggj(l,3)!+ghalf3
3609 a_temp(2,2)=aggj(l,4)!+ghalf4
3610 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3611 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3612 & +0.5d0*(pizda(1,1)+pizda(2,2))
3613 a_temp(1,1)=aggj1(l,1)
3614 a_temp(1,2)=aggj1(l,2)
3615 a_temp(2,1)=aggj1(l,3)
3616 a_temp(2,2)=aggj1(l,4)
3617 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3618 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3619 & +0.5d0*(pizda(1,1)+pizda(2,2))
3623 C-------------------------------------------------------------------------------
3624 subroutine eturn4(i,eello_turn4)
3625 C Third- and fourth-order contributions from turns
3626 implicit real*8 (a-h,o-z)
3627 include 'DIMENSIONS'
3628 include 'COMMON.IOUNITS'
3629 include 'COMMON.GEO'
3630 include 'COMMON.VAR'
3631 include 'COMMON.LOCAL'
3632 include 'COMMON.CHAIN'
3633 include 'COMMON.DERIV'
3634 include 'COMMON.INTERACT'
3635 include 'COMMON.CONTACTS'
3636 include 'COMMON.TORSION'
3637 include 'COMMON.VECTORS'
3638 include 'COMMON.FFIELD'
3639 include 'COMMON.CONTROL'
3641 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3642 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3643 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3644 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3645 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3646 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3647 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3650 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3652 C Fourth-order contributions
3660 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3661 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3662 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3667 iti1=itortyp(itype(i+1))
3668 iti2=itortyp(itype(i+2))
3669 iti3=itortyp(itype(i+3))
3670 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3671 call transpose2(EUg(1,1,i+1),e1t(1,1))
3672 call transpose2(Eug(1,1,i+2),e2t(1,1))
3673 call transpose2(Eug(1,1,i+3),e3t(1,1))
3674 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3675 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3676 s1=scalar2(b1(1,iti2),auxvec(1))
3677 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3678 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3679 s2=scalar2(b1(1,iti1),auxvec(1))
3680 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3681 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3682 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3683 eello_turn4=eello_turn4-(s1+s2+s3)
3684 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3685 & 'eturn4',i,j,-(s1+s2+s3)
3686 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3687 cd & ' eello_turn4_num',8*eello_turn4_num
3688 C Derivatives in gamma(i)
3689 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3690 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3691 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3692 s1=scalar2(b1(1,iti2),auxvec(1))
3693 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3694 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3695 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3696 C Derivatives in gamma(i+1)
3697 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3698 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3699 s2=scalar2(b1(1,iti1),auxvec(1))
3700 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3701 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3702 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3703 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3704 C Derivatives in gamma(i+2)
3705 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3706 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3707 s1=scalar2(b1(1,iti2),auxvec(1))
3708 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3709 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3710 s2=scalar2(b1(1,iti1),auxvec(1))
3711 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3712 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3713 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3714 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3715 C Cartesian derivatives
3716 C Derivatives of this turn contributions in DC(i+2)
3717 if (j.lt.nres-1) then
3719 a_temp(1,1)=agg(l,1)
3720 a_temp(1,2)=agg(l,2)
3721 a_temp(2,1)=agg(l,3)
3722 a_temp(2,2)=agg(l,4)
3723 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3724 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3725 s1=scalar2(b1(1,iti2),auxvec(1))
3726 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3727 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3728 s2=scalar2(b1(1,iti1),auxvec(1))
3729 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3730 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3731 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3733 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3736 C Remaining derivatives of this turn contribution
3738 a_temp(1,1)=aggi(l,1)
3739 a_temp(1,2)=aggi(l,2)
3740 a_temp(2,1)=aggi(l,3)
3741 a_temp(2,2)=aggi(l,4)
3742 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3743 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3744 s1=scalar2(b1(1,iti2),auxvec(1))
3745 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3746 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3747 s2=scalar2(b1(1,iti1),auxvec(1))
3748 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3749 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3750 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3751 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3752 a_temp(1,1)=aggi1(l,1)
3753 a_temp(1,2)=aggi1(l,2)
3754 a_temp(2,1)=aggi1(l,3)
3755 a_temp(2,2)=aggi1(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+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3766 a_temp(1,1)=aggj(l,1)
3767 a_temp(1,2)=aggj(l,2)
3768 a_temp(2,1)=aggj(l,3)
3769 a_temp(2,2)=aggj(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,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3780 a_temp(1,1)=aggj1(l,1)
3781 a_temp(1,2)=aggj1(l,2)
3782 a_temp(2,1)=aggj1(l,3)
3783 a_temp(2,2)=aggj1(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 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3794 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3798 C-----------------------------------------------------------------------------
3799 subroutine vecpr(u,v,w)
3800 implicit real*8(a-h,o-z)
3801 dimension u(3),v(3),w(3)
3802 w(1)=u(2)*v(3)-u(3)*v(2)
3803 w(2)=-u(1)*v(3)+u(3)*v(1)
3804 w(3)=u(1)*v(2)-u(2)*v(1)
3807 C-----------------------------------------------------------------------------
3808 subroutine unormderiv(u,ugrad,unorm,ungrad)
3809 C This subroutine computes the derivatives of a normalized vector u, given
3810 C the derivatives computed without normalization conditions, ugrad. Returns
3813 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3814 double precision vec(3)
3815 double precision scalar
3817 c write (2,*) 'ugrad',ugrad
3820 vec(i)=scalar(ugrad(1,i),u(1))
3822 c write (2,*) 'vec',vec
3825 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3828 c write (2,*) 'ungrad',ungrad
3831 C-----------------------------------------------------------------------------
3832 subroutine escp_soft_sphere(evdw2,evdw2_14)
3834 C This subroutine calculates the excluded-volume interaction energy between
3835 C peptide-group centers and side chains and its gradient in virtual-bond and
3836 C side-chain vectors.
3838 implicit real*8 (a-h,o-z)
3839 include 'DIMENSIONS'
3840 include 'COMMON.GEO'
3841 include 'COMMON.VAR'
3842 include 'COMMON.LOCAL'
3843 include 'COMMON.CHAIN'
3844 include 'COMMON.DERIV'
3845 include 'COMMON.INTERACT'
3846 include 'COMMON.FFIELD'
3847 include 'COMMON.IOUNITS'
3848 include 'COMMON.CONTROL'
3853 cd print '(a)','Enter ESCP'
3854 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3855 do i=iatscp_s,iatscp_e
3856 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3858 xi=0.5D0*(c(1,i)+c(1,i+1))
3859 yi=0.5D0*(c(2,i)+c(2,i+1))
3860 zi=0.5D0*(c(3,i)+c(3,i+1))
3862 do iint=1,nscp_gr(i)
3864 do j=iscpstart(i,iint),iscpend(i,iint)
3865 if (itype(j).eq.ntyp1) cycle
3866 itypj=iabs(itype(j))
3867 C Uncomment following three lines for SC-p interactions
3871 C Uncomment following three lines for Ca-p interactions
3875 rij=xj*xj+yj*yj+zj*zj
3878 if (rij.lt.r0ijsq) then
3879 evdwij=0.25d0*(rij-r0ijsq)**2
3887 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3892 cgrad if (j.lt.i) then
3893 cd write (iout,*) 'j<i'
3894 C Uncomment following three lines for SC-p interactions
3896 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3899 cd write (iout,*) 'j>i'
3901 cgrad ggg(k)=-ggg(k)
3902 C Uncomment following line for SC-p interactions
3903 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3907 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3909 cgrad kstart=min0(i+1,j)
3910 cgrad kend=max0(i-1,j-1)
3911 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3912 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3913 cgrad do k=kstart,kend
3915 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3919 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3920 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3928 C-----------------------------------------------------------------------------
3929 subroutine escp(evdw2,evdw2_14)
3931 C This subroutine calculates the excluded-volume interaction energy between
3932 C peptide-group centers and side chains and its gradient in virtual-bond and
3933 C side-chain vectors.
3935 implicit real*8 (a-h,o-z)
3936 include 'DIMENSIONS'
3937 include 'COMMON.GEO'
3938 include 'COMMON.VAR'
3939 include 'COMMON.LOCAL'
3940 include 'COMMON.CHAIN'
3941 include 'COMMON.DERIV'
3942 include 'COMMON.INTERACT'
3943 include 'COMMON.FFIELD'
3944 include 'COMMON.IOUNITS'
3945 include 'COMMON.CONTROL'
3949 cd print '(a)','Enter ESCP'
3950 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3951 do i=iatscp_s,iatscp_e
3952 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3954 xi=0.5D0*(c(1,i)+c(1,i+1))
3955 yi=0.5D0*(c(2,i)+c(2,i+1))
3956 zi=0.5D0*(c(3,i)+c(3,i+1))
3958 do iint=1,nscp_gr(i)
3960 do j=iscpstart(i,iint),iscpend(i,iint)
3961 itypj=iabs(itype(j))
3962 if (itypj.eq.ntyp1) cycle
3963 C Uncomment following three lines for SC-p interactions
3967 C Uncomment following three lines for Ca-p interactions
3971 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3973 e1=fac*fac*aad(itypj,iteli)
3974 e2=fac*bad(itypj,iteli)
3975 if (iabs(j-i) .le. 2) then
3978 evdw2_14=evdw2_14+e1+e2
3982 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3983 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3986 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3988 fac=-(evdwij+e1)*rrij
3992 cgrad if (j.lt.i) then
3993 cd write (iout,*) 'j<i'
3994 C Uncomment following three lines for SC-p interactions
3996 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3999 cd write (iout,*) 'j>i'
4001 cgrad ggg(k)=-ggg(k)
4002 C Uncomment following line for SC-p interactions
4003 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4004 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4008 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4010 cgrad kstart=min0(i+1,j)
4011 cgrad kend=max0(i-1,j-1)
4012 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4013 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4014 cgrad do k=kstart,kend
4016 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4020 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4021 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4029 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4030 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4031 gradx_scp(j,i)=expon*gradx_scp(j,i)
4034 C******************************************************************************
4038 C To save time the factor EXPON has been extracted from ALL components
4039 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4042 C******************************************************************************
4045 C--------------------------------------------------------------------------
4046 subroutine edis(ehpb)
4048 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4050 implicit real*8 (a-h,o-z)
4051 include 'DIMENSIONS'
4052 include 'COMMON.SBRIDGE'
4053 include 'COMMON.CHAIN'
4054 include 'COMMON.DERIV'
4055 include 'COMMON.VAR'
4056 include 'COMMON.INTERACT'
4057 include 'COMMON.IOUNITS'
4060 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4061 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4062 if (link_end.eq.0) return
4063 do i=link_start,link_end
4064 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4065 C CA-CA distance used in regularization of structure.
4068 C iii and jjj point to the residues for which the distance is assigned.
4069 if (ii.gt.nres) then
4076 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4077 c & dhpb(i),dhpb1(i),forcon(i)
4078 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4079 C distance and angle dependent SS bond potential.
4080 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4081 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4082 if (.not.dyn_ss .and. i.le.nss) then
4083 C 15/02/13 CC dynamic SSbond - additional check
4084 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4085 & iabs(itype(jjj)).eq.1) then
4086 call ssbond_ene(iii,jjj,eij)
4089 cd write (iout,*) "eij",eij
4091 C Calculate the distance between the two points and its difference from the
4095 C Get the force constant corresponding to this distance.
4097 C Calculate the contribution to energy.
4098 ehpb=ehpb+waga*rdis*rdis
4100 C Evaluate gradient.
4103 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4104 cd & ' waga=',waga,' fac=',fac
4106 ggg(j)=fac*(c(j,jj)-c(j,ii))
4108 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4109 C If this is a SC-SC distance, we need to calculate the contributions to the
4110 C Cartesian gradient in the SC vectors (ghpbx).
4113 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4114 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4117 cgrad do j=iii,jjj-1
4119 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4123 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4124 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4131 C--------------------------------------------------------------------------
4132 subroutine ssbond_ene(i,j,eij)
4134 C Calculate the distance and angle dependent SS-bond potential energy
4135 C using a free-energy function derived based on RHF/6-31G** ab initio
4136 C calculations of diethyl disulfide.
4138 C A. Liwo and U. Kozlowska, 11/24/03
4140 implicit real*8 (a-h,o-z)
4141 include 'DIMENSIONS'
4142 include 'COMMON.SBRIDGE'
4143 include 'COMMON.CHAIN'
4144 include 'COMMON.DERIV'
4145 include 'COMMON.LOCAL'
4146 include 'COMMON.INTERACT'
4147 include 'COMMON.VAR'
4148 include 'COMMON.IOUNITS'
4149 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4150 itypi=iabs(itype(i))
4154 dxi=dc_norm(1,nres+i)
4155 dyi=dc_norm(2,nres+i)
4156 dzi=dc_norm(3,nres+i)
4157 c dsci_inv=dsc_inv(itypi)
4158 dsci_inv=vbld_inv(nres+i)
4159 itypj=iabs(itype(j))
4160 c dscj_inv=dsc_inv(itypj)
4161 dscj_inv=vbld_inv(nres+j)
4165 dxj=dc_norm(1,nres+j)
4166 dyj=dc_norm(2,nres+j)
4167 dzj=dc_norm(3,nres+j)
4168 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4173 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4174 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4175 om12=dxi*dxj+dyi*dyj+dzi*dzj
4177 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4178 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4184 deltat12=om2-om1+2.0d0
4186 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4187 & +akct*deltad*deltat12
4188 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4189 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4190 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4191 c & " deltat12",deltat12," eij",eij
4192 ed=2*akcm*deltad+akct*deltat12
4194 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4195 eom1=-2*akth*deltat1-pom1-om2*pom2
4196 eom2= 2*akth*deltat2+pom1-om1*pom2
4199 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4200 ghpbx(k,i)=ghpbx(k,i)-ggk
4201 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4202 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4203 ghpbx(k,j)=ghpbx(k,j)+ggk
4204 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4205 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4206 ghpbc(k,i)=ghpbc(k,i)-ggk
4207 ghpbc(k,j)=ghpbc(k,j)+ggk
4210 C Calculate the components of the gradient in DC and X
4214 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4219 C--------------------------------------------------------------------------
4220 subroutine ebond(estr)
4222 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4224 implicit real*8 (a-h,o-z)
4225 include 'DIMENSIONS'
4226 include 'COMMON.LOCAL'
4227 include 'COMMON.GEO'
4228 include 'COMMON.INTERACT'
4229 include 'COMMON.DERIV'
4230 include 'COMMON.VAR'
4231 include 'COMMON.CHAIN'
4232 include 'COMMON.IOUNITS'
4233 include 'COMMON.NAMES'
4234 include 'COMMON.FFIELD'
4235 include 'COMMON.CONTROL'
4236 include 'COMMON.SETUP'
4237 double precision u(3),ud(3)
4240 do i=ibondp_start,ibondp_end
4241 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4242 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4244 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4245 & *dc(j,i-1)/vbld(i)
4247 if (energy_dec) write(iout,*)
4248 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4250 diff = vbld(i)-vbldp0
4251 if (energy_dec) write (iout,*)
4252 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4255 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4257 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4260 estr=0.5d0*AKP*estr+estr1
4262 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4264 do i=ibond_start,ibond_end
4266 if (iti.ne.10 .and. iti.ne.ntyp1) then
4269 diff=vbld(i+nres)-vbldsc0(1,iti)
4270 if (energy_dec) write (iout,*)
4271 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4272 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4273 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4275 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4279 diff=vbld(i+nres)-vbldsc0(j,iti)
4280 ud(j)=aksc(j,iti)*diff
4281 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4295 uprod2=uprod2*u(k)*u(k)
4299 usumsqder=usumsqder+ud(j)*uprod2
4301 estr=estr+uprod/usum
4303 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4311 C--------------------------------------------------------------------------
4312 subroutine ebend(etheta)
4314 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4315 C angles gamma and its derivatives in consecutive thetas and gammas.
4317 implicit real*8 (a-h,o-z)
4318 include 'DIMENSIONS'
4319 include 'COMMON.LOCAL'
4320 include 'COMMON.GEO'
4321 include 'COMMON.INTERACT'
4322 include 'COMMON.DERIV'
4323 include 'COMMON.VAR'
4324 include 'COMMON.CHAIN'
4325 include 'COMMON.IOUNITS'
4326 include 'COMMON.NAMES'
4327 include 'COMMON.FFIELD'
4328 include 'COMMON.CONTROL'
4329 common /calcthet/ term1,term2,termm,diffak,ratak,
4330 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4331 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4332 double precision y(2),z(2)
4334 c time11=dexp(-2*time)
4337 c write (*,'(a,i2)') 'EBEND ICG=',icg
4338 do i=ithet_start,ithet_end
4339 if (itype(i-1).eq.ntyp1) cycle
4340 C Zero the energy function and its derivative at 0 or pi.
4341 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4343 ichir1=isign(1,itype(i-2))
4344 ichir2=isign(1,itype(i))
4345 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4346 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4347 if (itype(i-1).eq.10) then
4348 itype1=isign(10,itype(i-2))
4349 ichir11=isign(1,itype(i-2))
4350 ichir12=isign(1,itype(i-2))
4351 itype2=isign(10,itype(i))
4352 ichir21=isign(1,itype(i))
4353 ichir22=isign(1,itype(i))
4356 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4359 if (phii.ne.phii) phii=150.0
4369 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4372 if (phii1.ne.phii1) phii1=150.0
4384 C Calculate the "mean" value of theta from the part of the distribution
4385 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4386 C In following comments this theta will be referred to as t_c.
4387 thet_pred_mean=0.0d0
4389 athetk=athet(k,it,ichir1,ichir2)
4390 bthetk=bthet(k,it,ichir1,ichir2)
4392 athetk=athet(k,itype1,ichir11,ichir12)
4393 bthetk=bthet(k,itype2,ichir21,ichir22)
4395 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4397 dthett=thet_pred_mean*ssd
4398 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4399 C Derivatives of the "mean" values in gamma1 and gamma2.
4400 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4401 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4402 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4403 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4405 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4406 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4407 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4408 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4410 if (theta(i).gt.pi-delta) then
4411 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4413 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4414 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4415 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4417 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4419 else if (theta(i).lt.delta) then
4420 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4421 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4422 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4424 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4425 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4428 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4431 etheta=etheta+ethetai
4432 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4434 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4435 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4436 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4438 C Ufff.... We've done all this!!!
4441 C---------------------------------------------------------------------------
4442 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4444 implicit real*8 (a-h,o-z)
4445 include 'DIMENSIONS'
4446 include 'COMMON.LOCAL'
4447 include 'COMMON.IOUNITS'
4448 common /calcthet/ term1,term2,termm,diffak,ratak,
4449 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4450 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4451 C Calculate the contributions to both Gaussian lobes.
4452 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4453 C The "polynomial part" of the "standard deviation" of this part of
4457 sig=sig*thet_pred_mean+polthet(j,it)
4459 C Derivative of the "interior part" of the "standard deviation of the"
4460 C gamma-dependent Gaussian lobe in t_c.
4461 sigtc=3*polthet(3,it)
4463 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4466 C Set the parameters of both Gaussian lobes of the distribution.
4467 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4468 fac=sig*sig+sigc0(it)
4471 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4472 sigsqtc=-4.0D0*sigcsq*sigtc
4473 c print *,i,sig,sigtc,sigsqtc
4474 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4475 sigtc=-sigtc/(fac*fac)
4476 C Following variable is sigma(t_c)**(-2)
4477 sigcsq=sigcsq*sigcsq
4479 sig0inv=1.0D0/sig0i**2
4480 delthec=thetai-thet_pred_mean
4481 delthe0=thetai-theta0i
4482 term1=-0.5D0*sigcsq*delthec*delthec
4483 term2=-0.5D0*sig0inv*delthe0*delthe0
4484 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4485 C NaNs in taking the logarithm. We extract the largest exponent which is added
4486 C to the energy (this being the log of the distribution) at the end of energy
4487 C term evaluation for this virtual-bond angle.
4488 if (term1.gt.term2) then
4490 term2=dexp(term2-termm)
4494 term1=dexp(term1-termm)
4497 C The ratio between the gamma-independent and gamma-dependent lobes of
4498 C the distribution is a Gaussian function of thet_pred_mean too.
4499 diffak=gthet(2,it)-thet_pred_mean
4500 ratak=diffak/gthet(3,it)**2
4501 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4502 C Let's differentiate it in thet_pred_mean NOW.
4504 C Now put together the distribution terms to make complete distribution.
4505 termexp=term1+ak*term2
4506 termpre=sigc+ak*sig0i
4507 C Contribution of the bending energy from this theta is just the -log of
4508 C the sum of the contributions from the two lobes and the pre-exponential
4509 C factor. Simple enough, isn't it?
4510 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4511 C NOW the derivatives!!!
4512 C 6/6/97 Take into account the deformation.
4513 E_theta=(delthec*sigcsq*term1
4514 & +ak*delthe0*sig0inv*term2)/termexp
4515 E_tc=((sigtc+aktc*sig0i)/termpre
4516 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4517 & aktc*term2)/termexp)
4520 c-----------------------------------------------------------------------------
4521 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4522 implicit real*8 (a-h,o-z)
4523 include 'DIMENSIONS'
4524 include 'COMMON.LOCAL'
4525 include 'COMMON.IOUNITS'
4526 common /calcthet/ term1,term2,termm,diffak,ratak,
4527 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4528 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4529 delthec=thetai-thet_pred_mean
4530 delthe0=thetai-theta0i
4531 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4532 t3 = thetai-thet_pred_mean
4536 t14 = t12+t6*sigsqtc
4538 t21 = thetai-theta0i
4544 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4545 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4546 & *(-t12*t9-ak*sig0inv*t27)
4550 C--------------------------------------------------------------------------
4551 subroutine ebend(etheta)
4553 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4554 C angles gamma and its derivatives in consecutive thetas and gammas.
4555 C ab initio-derived potentials from
4556 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4558 implicit real*8 (a-h,o-z)
4559 include 'DIMENSIONS'
4560 include 'COMMON.LOCAL'
4561 include 'COMMON.GEO'
4562 include 'COMMON.INTERACT'
4563 include 'COMMON.DERIV'
4564 include 'COMMON.VAR'
4565 include 'COMMON.CHAIN'
4566 include 'COMMON.IOUNITS'
4567 include 'COMMON.NAMES'
4568 include 'COMMON.FFIELD'
4569 include 'COMMON.CONTROL'
4570 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4571 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4572 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4573 & sinph1ph2(maxdouble,maxdouble)
4574 logical lprn /.false./, lprn1 /.false./
4576 do i=ithet_start,ithet_end
4577 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4578 &(itype(i).eq.ntyp1)) cycle
4579 C print *,i,theta(i)
4580 if (iabs(itype(i+1)).eq.20) iblock=2
4581 if (iabs(itype(i+1)).ne.20) iblock=1
4585 theti2=0.5d0*theta(i)
4586 ityp2=ithetyp((itype(i-1)))
4588 coskt(k)=dcos(k*theti2)
4589 sinkt(k)=dsin(k*theti2)
4593 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4596 if (phii.ne.phii) phii=150.0
4600 ityp1=ithetyp((itype(i-2)))
4601 C propagation of chirality for glycine type
4603 cosph1(k)=dcos(k*phii)
4604 sinph1(k)=dsin(k*phii)
4609 ityp1=ithetyp((itype(i-2)))
4614 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4617 if (phii1.ne.phii1) phii1=150.0
4622 ityp3=ithetyp((itype(i)))
4624 cosph2(k)=dcos(k*phii1)
4625 sinph2(k)=dsin(k*phii1)
4629 ityp3=ithetyp((itype(i)))
4635 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4638 ccl=cosph1(l)*cosph2(k-l)
4639 ssl=sinph1(l)*sinph2(k-l)
4640 scl=sinph1(l)*cosph2(k-l)
4641 csl=cosph1(l)*sinph2(k-l)
4642 cosph1ph2(l,k)=ccl-ssl
4643 cosph1ph2(k,l)=ccl+ssl
4644 sinph1ph2(l,k)=scl+csl
4645 sinph1ph2(k,l)=scl-csl
4649 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4650 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4651 write (iout,*) "coskt and sinkt"
4653 write (iout,*) k,coskt(k),sinkt(k)
4657 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4658 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4661 & write (iout,*) "k",k,"
4662 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4663 & " ethetai",ethetai
4666 write (iout,*) "cosph and sinph"
4668 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4670 write (iout,*) "cosph1ph2 and sinph2ph2"
4673 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4674 & sinph1ph2(l,k),sinph1ph2(k,l)
4677 write(iout,*) "ethetai",ethetai
4682 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4683 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4684 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4685 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4686 ethetai=ethetai+sinkt(m)*aux
4687 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4688 dephii=dephii+k*sinkt(m)*(
4689 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4690 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4691 dephii1=dephii1+k*sinkt(m)*(
4692 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4693 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4695 & write (iout,*) "m",m," k",k," bbthet",
4696 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4697 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4698 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4699 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4700 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4703 C print *,"cosph1", (cosph1(k), k=1,nsingle)
4704 C print *,"cosph2", (cosph2(k), k=1,nsingle)
4705 C print *,"sinph1", (sinph1(k), k=1,nsingle)
4706 C print *,"sinph2", (sinph2(k), k=1,nsingle)
4708 & write(iout,*) "ethetai",ethetai
4709 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4713 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4714 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4715 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4716 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4717 ethetai=ethetai+sinkt(m)*aux
4718 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4719 dephii=dephii+l*sinkt(m)*(
4720 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4721 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4722 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4723 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4724 dephii1=dephii1+(k-l)*sinkt(m)*(
4725 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4726 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4727 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4728 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4730 write (iout,*) "m",m," k",k," l",l," ffthet",
4731 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4732 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4733 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4734 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4735 & " ethetai",ethetai
4736 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4737 & cosph1ph2(k,l)*sinkt(m),
4738 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4747 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4748 & i,theta(i)*rad2deg,phii*rad2deg,
4749 & phii1*rad2deg,ethetai
4751 etheta=etheta+ethetai
4752 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4753 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4754 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4760 c-----------------------------------------------------------------------------
4761 subroutine esc(escloc)
4762 C Calculate the local energy of a side chain and its derivatives in the
4763 C corresponding virtual-bond valence angles THETA and the spherical angles
4765 implicit real*8 (a-h,o-z)
4766 include 'DIMENSIONS'
4767 include 'COMMON.GEO'
4768 include 'COMMON.LOCAL'
4769 include 'COMMON.VAR'
4770 include 'COMMON.INTERACT'
4771 include 'COMMON.DERIV'
4772 include 'COMMON.CHAIN'
4773 include 'COMMON.IOUNITS'
4774 include 'COMMON.NAMES'
4775 include 'COMMON.FFIELD'
4776 include 'COMMON.CONTROL'
4777 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4778 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4779 common /sccalc/ time11,time12,time112,theti,it,nlobit
4782 c write (iout,'(a)') 'ESC'
4783 do i=loc_start,loc_end
4785 if (it.eq.ntyp1) cycle
4786 if (it.eq.10) goto 1
4787 nlobit=nlob(iabs(it))
4788 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4789 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4790 theti=theta(i+1)-pipol
4795 if (x(2).gt.pi-delta) then
4799 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4801 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4802 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4804 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4805 & ddersc0(1),dersc(1))
4806 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4807 & ddersc0(3),dersc(3))
4809 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4811 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4812 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4813 & dersc0(2),esclocbi,dersc02)
4814 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4816 call splinthet(x(2),0.5d0*delta,ss,ssd)
4821 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4823 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4824 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4826 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4828 c write (iout,*) escloci
4829 else if (x(2).lt.delta) then
4833 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4835 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4836 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4838 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4839 & ddersc0(1),dersc(1))
4840 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4841 & ddersc0(3),dersc(3))
4843 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4845 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4846 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4847 & dersc0(2),esclocbi,dersc02)
4848 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4853 call splinthet(x(2),0.5d0*delta,ss,ssd)
4855 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4857 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4858 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4860 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4861 c write (iout,*) escloci
4863 call enesc(x,escloci,dersc,ddummy,.false.)
4866 escloc=escloc+escloci
4867 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4868 & 'escloc',i,escloci
4869 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4871 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4873 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4874 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4879 C---------------------------------------------------------------------------
4880 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4881 implicit real*8 (a-h,o-z)
4882 include 'DIMENSIONS'
4883 include 'COMMON.GEO'
4884 include 'COMMON.LOCAL'
4885 include 'COMMON.IOUNITS'
4886 common /sccalc/ time11,time12,time112,theti,it,nlobit
4887 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4888 double precision contr(maxlob,-1:1)
4890 c write (iout,*) 'it=',it,' nlobit=',nlobit
4894 if (mixed) ddersc(j)=0.0d0
4898 C Because of periodicity of the dependence of the SC energy in omega we have
4899 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4900 C To avoid underflows, first compute & store the exponents.
4908 z(k)=x(k)-censc(k,j,it)
4913 Axk=Axk+gaussc(l,k,j,it)*z(l)
4919 expfac=expfac+Ax(k,j,iii)*z(k)
4927 C As in the case of ebend, we want to avoid underflows in exponentiation and
4928 C subsequent NaNs and INFs in energy calculation.
4929 C Find the largest exponent
4933 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4937 cd print *,'it=',it,' emin=',emin
4939 C Compute the contribution to SC energy and derivatives
4944 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
4945 if(adexp.ne.adexp) adexp=1.0
4948 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4950 cd print *,'j=',j,' expfac=',expfac
4951 escloc_i=escloc_i+expfac
4953 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4957 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4958 & +gaussc(k,2,j,it))*expfac
4965 dersc(1)=dersc(1)/cos(theti)**2
4966 ddersc(1)=ddersc(1)/cos(theti)**2
4969 escloci=-(dlog(escloc_i)-emin)
4971 dersc(j)=dersc(j)/escloc_i
4975 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4980 C------------------------------------------------------------------------------
4981 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4982 implicit real*8 (a-h,o-z)
4983 include 'DIMENSIONS'
4984 include 'COMMON.GEO'
4985 include 'COMMON.LOCAL'
4986 include 'COMMON.IOUNITS'
4987 common /sccalc/ time11,time12,time112,theti,it,nlobit
4988 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4989 double precision contr(maxlob)
5000 z(k)=x(k)-censc(k,j,it)
5006 Axk=Axk+gaussc(l,k,j,it)*z(l)
5012 expfac=expfac+Ax(k,j)*z(k)
5017 C As in the case of ebend, we want to avoid underflows in exponentiation and
5018 C subsequent NaNs and INFs in energy calculation.
5019 C Find the largest exponent
5022 if (emin.gt.contr(j)) emin=contr(j)
5026 C Compute the contribution to SC energy and derivatives
5030 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5031 escloc_i=escloc_i+expfac
5033 dersc(k)=dersc(k)+Ax(k,j)*expfac
5035 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5036 & +gaussc(1,2,j,it))*expfac
5040 dersc(1)=dersc(1)/cos(theti)**2
5041 dersc12=dersc12/cos(theti)**2
5042 escloci=-(dlog(escloc_i)-emin)
5044 dersc(j)=dersc(j)/escloc_i
5046 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5050 c----------------------------------------------------------------------------------
5051 subroutine esc(escloc)
5052 C Calculate the local energy of a side chain and its derivatives in the
5053 C corresponding virtual-bond valence angles THETA and the spherical angles
5054 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5055 C added by Urszula Kozlowska. 07/11/2007
5057 implicit real*8 (a-h,o-z)
5058 include 'DIMENSIONS'
5059 include 'COMMON.GEO'
5060 include 'COMMON.LOCAL'
5061 include 'COMMON.VAR'
5062 include 'COMMON.SCROT'
5063 include 'COMMON.INTERACT'
5064 include 'COMMON.DERIV'
5065 include 'COMMON.CHAIN'
5066 include 'COMMON.IOUNITS'
5067 include 'COMMON.NAMES'
5068 include 'COMMON.FFIELD'
5069 include 'COMMON.CONTROL'
5070 include 'COMMON.VECTORS'
5071 double precision x_prime(3),y_prime(3),z_prime(3)
5072 & , sumene,dsc_i,dp2_i,x(65),
5073 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5074 & de_dxx,de_dyy,de_dzz,de_dt
5075 double precision s1_t,s1_6_t,s2_t,s2_6_t
5077 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5078 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5079 & dt_dCi(3),dt_dCi1(3)
5080 common /sccalc/ time11,time12,time112,theti,it,nlobit
5083 do i=loc_start,loc_end
5084 if (itype(i).eq.ntyp1) cycle
5085 costtab(i+1) =dcos(theta(i+1))
5086 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5087 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5088 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5089 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5090 cosfac=dsqrt(cosfac2)
5091 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5092 sinfac=dsqrt(sinfac2)
5094 if (it.eq.10) goto 1
5096 C Compute the axes of tghe local cartesian coordinates system; store in
5097 c x_prime, y_prime and z_prime
5104 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5105 C & dc_norm(3,i+nres)
5107 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5108 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5111 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5114 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5115 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5116 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5117 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5118 c & " xy",scalar(x_prime(1),y_prime(1)),
5119 c & " xz",scalar(x_prime(1),z_prime(1)),
5120 c & " yy",scalar(y_prime(1),y_prime(1)),
5121 c & " yz",scalar(y_prime(1),z_prime(1)),
5122 c & " zz",scalar(z_prime(1),z_prime(1))
5124 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5125 C to local coordinate system. Store in xx, yy, zz.
5131 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5132 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5133 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5140 C Compute the energy of the ith side cbain
5142 c write (2,*) "xx",xx," yy",yy," zz",zz
5145 x(j) = sc_parmin(j,it)
5148 Cc diagnostics - remove later
5150 yy1 = dsin(alph(2))*dcos(omeg(2))
5151 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5152 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5153 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5155 C," --- ", xx_w,yy_w,zz_w
5158 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5159 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5161 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5162 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5164 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5165 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5166 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5167 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5168 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5170 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5171 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5172 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5173 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5174 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5176 dsc_i = 0.743d0+x(61)
5178 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5179 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5180 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5181 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5182 s1=(1+x(63))/(0.1d0 + dscp1)
5183 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5184 s2=(1+x(65))/(0.1d0 + dscp2)
5185 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5186 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5187 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5188 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5190 c & dscp1,dscp2,sumene
5191 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5192 escloc = escloc + sumene
5193 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5198 C This section to check the numerical derivatives of the energy of ith side
5199 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5200 C #define DEBUG in the code to turn it on.
5202 write (2,*) "sumene =",sumene
5206 write (2,*) xx,yy,zz
5207 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5208 de_dxx_num=(sumenep-sumene)/aincr
5210 write (2,*) "xx+ sumene from enesc=",sumenep
5213 write (2,*) xx,yy,zz
5214 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5215 de_dyy_num=(sumenep-sumene)/aincr
5217 write (2,*) "yy+ sumene from enesc=",sumenep
5220 write (2,*) xx,yy,zz
5221 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5222 de_dzz_num=(sumenep-sumene)/aincr
5224 write (2,*) "zz+ sumene from enesc=",sumenep
5225 costsave=cost2tab(i+1)
5226 sintsave=sint2tab(i+1)
5227 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5228 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5229 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5230 de_dt_num=(sumenep-sumene)/aincr
5231 write (2,*) " t+ sumene from enesc=",sumenep
5232 cost2tab(i+1)=costsave
5233 sint2tab(i+1)=sintsave
5234 C End of diagnostics section.
5237 C Compute the gradient of esc
5239 c zz=zz*dsign(1.0,dfloat(itype(i)))
5240 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5241 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5242 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5243 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5244 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5245 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5246 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5247 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5248 pom1=(sumene3*sint2tab(i+1)+sumene1)
5249 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5250 pom2=(sumene4*cost2tab(i+1)+sumene2)
5251 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5252 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5253 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5254 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5256 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5257 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5258 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5260 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5261 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5262 & +(pom1+pom2)*pom_dx
5264 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5267 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5268 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5269 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5271 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5272 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5273 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5274 & +x(59)*zz**2 +x(60)*xx*zz
5275 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5276 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5277 & +(pom1-pom2)*pom_dy
5279 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5282 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5283 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5284 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5285 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5286 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5287 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5288 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5289 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5291 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5294 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5295 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5296 & +pom1*pom_dt1+pom2*pom_dt2
5298 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5303 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5304 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5305 cosfac2xx=cosfac2*xx
5306 sinfac2yy=sinfac2*yy
5308 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5310 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5312 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5313 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5314 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5315 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5316 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5317 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5318 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5319 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5320 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5321 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5325 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5326 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5327 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5328 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5331 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5332 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5333 dZZ_XYZ(k)=vbld_inv(i+nres)*
5334 & (z_prime(k)-zz*dC_norm(k,i+nres))
5336 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5337 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5341 dXX_Ctab(k,i)=dXX_Ci(k)
5342 dXX_C1tab(k,i)=dXX_Ci1(k)
5343 dYY_Ctab(k,i)=dYY_Ci(k)
5344 dYY_C1tab(k,i)=dYY_Ci1(k)
5345 dZZ_Ctab(k,i)=dZZ_Ci(k)
5346 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5347 dXX_XYZtab(k,i)=dXX_XYZ(k)
5348 dYY_XYZtab(k,i)=dYY_XYZ(k)
5349 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5353 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5354 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5355 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5356 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5357 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5359 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5360 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5361 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5362 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5363 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5364 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5365 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5366 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5368 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5369 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5371 C to check gradient call subroutine check_grad
5377 c------------------------------------------------------------------------------
5378 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5380 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5381 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5382 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5383 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5385 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5386 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5388 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5389 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5390 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5391 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5392 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5394 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5395 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5396 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5397 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5398 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5400 dsc_i = 0.743d0+x(61)
5402 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5403 & *(xx*cost2+yy*sint2))
5404 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5405 & *(xx*cost2-yy*sint2))
5406 s1=(1+x(63))/(0.1d0 + dscp1)
5407 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5408 s2=(1+x(65))/(0.1d0 + dscp2)
5409 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5410 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5411 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5416 c------------------------------------------------------------------------------
5417 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5419 C This procedure calculates two-body contact function g(rij) and its derivative:
5422 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5425 C where x=(rij-r0ij)/delta
5427 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5430 double precision rij,r0ij,eps0ij,fcont,fprimcont
5431 double precision x,x2,x4,delta
5435 if (x.lt.-1.0D0) then
5438 else if (x.le.1.0D0) then
5441 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5442 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5449 c------------------------------------------------------------------------------
5450 subroutine splinthet(theti,delta,ss,ssder)
5451 implicit real*8 (a-h,o-z)
5452 include 'DIMENSIONS'
5453 include 'COMMON.VAR'
5454 include 'COMMON.GEO'
5457 if (theti.gt.pipol) then
5458 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5460 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5465 c------------------------------------------------------------------------------
5466 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5468 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5469 double precision ksi,ksi2,ksi3,a1,a2,a3
5470 a1=fprim0*delta/(f1-f0)
5476 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5477 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5480 c------------------------------------------------------------------------------
5481 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5483 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5484 double precision ksi,ksi2,ksi3,a1,a2,a3
5489 a2=3*(f1x-f0x)-2*fprim0x*delta
5490 a3=fprim0x*delta-2*(f1x-f0x)
5491 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5494 C-----------------------------------------------------------------------------
5496 C-----------------------------------------------------------------------------
5497 subroutine etor(etors,edihcnstr)
5498 implicit real*8 (a-h,o-z)
5499 include 'DIMENSIONS'
5500 include 'COMMON.VAR'
5501 include 'COMMON.GEO'
5502 include 'COMMON.LOCAL'
5503 include 'COMMON.TORSION'
5504 include 'COMMON.INTERACT'
5505 include 'COMMON.DERIV'
5506 include 'COMMON.CHAIN'
5507 include 'COMMON.NAMES'
5508 include 'COMMON.IOUNITS'
5509 include 'COMMON.FFIELD'
5510 include 'COMMON.TORCNSTR'
5511 include 'COMMON.CONTROL'
5513 C Set lprn=.true. for debugging
5517 do i=iphi_start,iphi_end
5519 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5520 & .or. itype(i).eq.ntyp1) cycle
5521 itori=itortyp(itype(i-2))
5522 itori1=itortyp(itype(i-1))
5525 C Proline-Proline pair is a special case...
5526 if (itori.eq.3 .and. itori1.eq.3) then
5527 if (phii.gt.-dwapi3) then
5529 fac=1.0D0/(1.0D0-cosphi)
5530 etorsi=v1(1,3,3)*fac
5531 etorsi=etorsi+etorsi
5532 etors=etors+etorsi-v1(1,3,3)
5533 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5534 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5537 v1ij=v1(j+1,itori,itori1)
5538 v2ij=v2(j+1,itori,itori1)
5541 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5542 if (energy_dec) etors_ii=etors_ii+
5543 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5544 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5548 v1ij=v1(j,itori,itori1)
5549 v2ij=v2(j,itori,itori1)
5552 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5553 if (energy_dec) etors_ii=etors_ii+
5554 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5555 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5558 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5561 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5562 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5563 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5564 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5565 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5567 ! 6/20/98 - dihedral angle constraints
5570 itori=idih_constr(i)
5573 if (difi.gt.drange(i)) then
5575 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5576 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5577 else if (difi.lt.-drange(i)) then
5579 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5580 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5582 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5583 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5585 ! write (iout,*) 'edihcnstr',edihcnstr
5588 c------------------------------------------------------------------------------
5589 subroutine etor_d(etors_d)
5593 c----------------------------------------------------------------------------
5595 subroutine etor(etors,edihcnstr)
5596 implicit real*8 (a-h,o-z)
5597 include 'DIMENSIONS'
5598 include 'COMMON.VAR'
5599 include 'COMMON.GEO'
5600 include 'COMMON.LOCAL'
5601 include 'COMMON.TORSION'
5602 include 'COMMON.INTERACT'
5603 include 'COMMON.DERIV'
5604 include 'COMMON.CHAIN'
5605 include 'COMMON.NAMES'
5606 include 'COMMON.IOUNITS'
5607 include 'COMMON.FFIELD'
5608 include 'COMMON.TORCNSTR'
5609 include 'COMMON.CONTROL'
5611 C Set lprn=.true. for debugging
5615 do i=iphi_start,iphi_end
5616 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5617 & .or. itype(i).eq.ntyp1) cycle
5619 if (iabs(itype(i)).eq.20) then
5624 itori=itortyp(itype(i-2))
5625 itori1=itortyp(itype(i-1))
5628 C Regular cosine and sine terms
5629 do j=1,nterm(itori,itori1,iblock)
5630 v1ij=v1(j,itori,itori1,iblock)
5631 v2ij=v2(j,itori,itori1,iblock)
5634 etors=etors+v1ij*cosphi+v2ij*sinphi
5635 if (energy_dec) etors_ii=etors_ii+
5636 & v1ij*cosphi+v2ij*sinphi
5637 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5641 C E = SUM ----------------------------------- - v1
5642 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5644 cosphi=dcos(0.5d0*phii)
5645 sinphi=dsin(0.5d0*phii)
5646 do j=1,nlor(itori,itori1,iblock)
5647 vl1ij=vlor1(j,itori,itori1)
5648 vl2ij=vlor2(j,itori,itori1)
5649 vl3ij=vlor3(j,itori,itori1)
5650 pom=vl2ij*cosphi+vl3ij*sinphi
5651 pom1=1.0d0/(pom*pom+1.0d0)
5652 etors=etors+vl1ij*pom1
5653 if (energy_dec) etors_ii=etors_ii+
5656 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5658 C Subtract the constant term
5659 etors=etors-v0(itori,itori1,iblock)
5660 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5661 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5663 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5664 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5665 & (v1(j,itori,itori1,iblock),j=1,6),
5666 & (v2(j,itori,itori1,iblock),j=1,6)
5667 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5668 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5670 ! 6/20/98 - dihedral angle constraints
5672 c do i=1,ndih_constr
5673 do i=idihconstr_start,idihconstr_end
5674 itori=idih_constr(i)
5676 difi=pinorm(phii-phi0(i))
5677 if (difi.gt.drange(i)) then
5679 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5680 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5681 else if (difi.lt.-drange(i)) then
5683 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5684 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5688 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5689 cd & rad2deg*phi0(i), rad2deg*drange(i),
5690 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5692 cd write (iout,*) 'edihcnstr',edihcnstr
5695 c----------------------------------------------------------------------------
5696 subroutine etor_d(etors_d)
5697 C 6/23/01 Compute double torsional energy
5698 implicit real*8 (a-h,o-z)
5699 include 'DIMENSIONS'
5700 include 'COMMON.VAR'
5701 include 'COMMON.GEO'
5702 include 'COMMON.LOCAL'
5703 include 'COMMON.TORSION'
5704 include 'COMMON.INTERACT'
5705 include 'COMMON.DERIV'
5706 include 'COMMON.CHAIN'
5707 include 'COMMON.NAMES'
5708 include 'COMMON.IOUNITS'
5709 include 'COMMON.FFIELD'
5710 include 'COMMON.TORCNSTR'
5712 C Set lprn=.true. for debugging
5716 c write(iout,*) "a tu??"
5717 do i=iphid_start,iphid_end
5718 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5719 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5720 itori=itortyp(itype(i-2))
5721 itori1=itortyp(itype(i-1))
5722 itori2=itortyp(itype(i))
5728 if (iabs(itype(i+1)).eq.20) iblock=2
5730 C Regular cosine and sine terms
5731 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5732 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5733 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5734 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5735 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5736 cosphi1=dcos(j*phii)
5737 sinphi1=dsin(j*phii)
5738 cosphi2=dcos(j*phii1)
5739 sinphi2=dsin(j*phii1)
5740 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5741 & v2cij*cosphi2+v2sij*sinphi2
5742 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5743 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5745 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5747 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5748 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5749 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5750 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5751 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5752 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5753 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5754 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5755 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5756 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5757 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5758 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5759 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5760 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5763 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5764 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5769 c------------------------------------------------------------------------------
5770 subroutine eback_sc_corr(esccor)
5771 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5772 c conformational states; temporarily implemented as differences
5773 c between UNRES torsional potentials (dependent on three types of
5774 c residues) and the torsional potentials dependent on all 20 types
5775 c of residues computed from AM1 energy surfaces of terminally-blocked
5776 c amino-acid residues.
5777 implicit real*8 (a-h,o-z)
5778 include 'DIMENSIONS'
5779 include 'COMMON.VAR'
5780 include 'COMMON.GEO'
5781 include 'COMMON.LOCAL'
5782 include 'COMMON.TORSION'
5783 include 'COMMON.SCCOR'
5784 include 'COMMON.INTERACT'
5785 include 'COMMON.DERIV'
5786 include 'COMMON.CHAIN'
5787 include 'COMMON.NAMES'
5788 include 'COMMON.IOUNITS'
5789 include 'COMMON.FFIELD'
5790 include 'COMMON.CONTROL'
5792 C Set lprn=.true. for debugging
5795 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5797 do i=itau_start,itau_end
5798 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5800 isccori=isccortyp(itype(i-2))
5801 isccori1=isccortyp(itype(i-1))
5802 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5804 do intertyp=1,3 !intertyp
5805 cc Added 09 May 2012 (Adasko)
5806 cc Intertyp means interaction type of backbone mainchain correlation:
5807 c 1 = SC...Ca...Ca...Ca
5808 c 2 = Ca...Ca...Ca...SC
5809 c 3 = SC...Ca...Ca...SCi
5811 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5812 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5813 & (itype(i-1).eq.ntyp1)))
5814 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5815 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5816 & .or.(itype(i).eq.ntyp1)))
5817 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5818 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5819 & (itype(i-3).eq.ntyp1)))) cycle
5820 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5821 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5823 do j=1,nterm_sccor(isccori,isccori1)
5824 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5825 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5826 cosphi=dcos(j*tauangle(intertyp,i))
5827 sinphi=dsin(j*tauangle(intertyp,i))
5828 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5829 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5831 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5832 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5834 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5835 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
5836 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
5837 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5838 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5844 c----------------------------------------------------------------------------
5845 subroutine multibody(ecorr)
5846 C This subroutine calculates multi-body contributions to energy following
5847 C the idea of Skolnick et al. If side chains I and J make a contact and
5848 C at the same time side chains I+1 and J+1 make a contact, an extra
5849 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5850 implicit real*8 (a-h,o-z)
5851 include 'DIMENSIONS'
5852 include 'COMMON.IOUNITS'
5853 include 'COMMON.DERIV'
5854 include 'COMMON.INTERACT'
5855 include 'COMMON.CONTACTS'
5856 double precision gx(3),gx1(3)
5859 C Set lprn=.true. for debugging
5863 write (iout,'(a)') 'Contact function values:'
5865 write (iout,'(i2,20(1x,i2,f10.5))')
5866 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5881 num_conti=num_cont(i)
5882 num_conti1=num_cont(i1)
5887 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5888 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5889 cd & ' ishift=',ishift
5890 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5891 C The system gains extra energy.
5892 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5893 endif ! j1==j+-ishift
5902 c------------------------------------------------------------------------------
5903 double precision function esccorr(i,j,k,l,jj,kk)
5904 implicit real*8 (a-h,o-z)
5905 include 'DIMENSIONS'
5906 include 'COMMON.IOUNITS'
5907 include 'COMMON.DERIV'
5908 include 'COMMON.INTERACT'
5909 include 'COMMON.CONTACTS'
5910 double precision gx(3),gx1(3)
5915 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5916 C Calculate the multi-body contribution to energy.
5917 C Calculate multi-body contributions to the gradient.
5918 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5919 cd & k,l,(gacont(m,kk,k),m=1,3)
5921 gx(m) =ekl*gacont(m,jj,i)
5922 gx1(m)=eij*gacont(m,kk,k)
5923 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5924 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5925 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5926 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5930 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5935 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5941 c------------------------------------------------------------------------------
5942 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5943 C This subroutine calculates multi-body contributions to hydrogen-bonding
5944 implicit real*8 (a-h,o-z)
5945 include 'DIMENSIONS'
5946 include 'COMMON.IOUNITS'
5949 parameter (max_cont=maxconts)
5950 parameter (max_dim=26)
5951 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5952 double precision zapas(max_dim,maxconts,max_fg_procs),
5953 & zapas_recv(max_dim,maxconts,max_fg_procs)
5954 common /przechowalnia/ zapas
5955 integer status(MPI_STATUS_SIZE),req(maxconts*2),
5956 & status_array(MPI_STATUS_SIZE,maxconts*2)
5958 include 'COMMON.SETUP'
5959 include 'COMMON.FFIELD'
5960 include 'COMMON.DERIV'
5961 include 'COMMON.INTERACT'
5962 include 'COMMON.CONTACTS'
5963 include 'COMMON.CONTROL'
5964 include 'COMMON.LOCAL'
5965 double precision gx(3),gx1(3),time00
5968 C Set lprn=.true. for debugging
5973 if (nfgtasks.le.1) goto 30
5975 write (iout,'(a)') 'Contact function values before RECEIVE:'
5977 write (iout,'(2i3,50(1x,i2,f5.2))')
5978 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5979 & j=1,num_cont_hb(i))
5983 do i=1,ntask_cont_from
5986 do i=1,ntask_cont_to
5989 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
5991 C Make the list of contacts to send to send to other procesors
5992 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
5994 do i=iturn3_start,iturn3_end
5995 c write (iout,*) "make contact list turn3",i," num_cont",
5997 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
5999 do i=iturn4_start,iturn4_end
6000 c write (iout,*) "make contact list turn4",i," num_cont",
6002 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6006 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6008 do j=1,num_cont_hb(i)
6011 iproc=iint_sent_local(k,jjc,ii)
6012 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6013 if (iproc.gt.0) then
6014 ncont_sent(iproc)=ncont_sent(iproc)+1
6015 nn=ncont_sent(iproc)
6017 zapas(2,nn,iproc)=jjc
6018 zapas(3,nn,iproc)=facont_hb(j,i)
6019 zapas(4,nn,iproc)=ees0p(j,i)
6020 zapas(5,nn,iproc)=ees0m(j,i)
6021 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6022 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6023 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6024 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6025 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6026 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6027 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6028 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6029 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6030 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6031 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6032 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6033 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6034 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6035 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6036 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6037 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6038 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6039 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6040 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6041 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6048 & "Numbers of contacts to be sent to other processors",
6049 & (ncont_sent(i),i=1,ntask_cont_to)
6050 write (iout,*) "Contacts sent"
6051 do ii=1,ntask_cont_to
6053 iproc=itask_cont_to(ii)
6054 write (iout,*) nn," contacts to processor",iproc,
6055 & " of CONT_TO_COMM group"
6057 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6065 CorrelID1=nfgtasks+fg_rank+1
6067 C Receive the numbers of needed contacts from other processors
6068 do ii=1,ntask_cont_from
6069 iproc=itask_cont_from(ii)
6071 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6072 & FG_COMM,req(ireq),IERR)
6074 c write (iout,*) "IRECV ended"
6076 C Send the number of contacts needed by other processors
6077 do ii=1,ntask_cont_to
6078 iproc=itask_cont_to(ii)
6080 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6081 & FG_COMM,req(ireq),IERR)
6083 c write (iout,*) "ISEND ended"
6084 c write (iout,*) "number of requests (nn)",ireq
6087 & call MPI_Waitall(ireq,req,status_array,ierr)
6089 c & "Numbers of contacts to be received from other processors",
6090 c & (ncont_recv(i),i=1,ntask_cont_from)
6094 do ii=1,ntask_cont_from
6095 iproc=itask_cont_from(ii)
6097 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6098 c & " of CONT_TO_COMM group"
6102 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6103 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6104 c write (iout,*) "ireq,req",ireq,req(ireq)
6107 C Send the contacts to processors that need them
6108 do ii=1,ntask_cont_to
6109 iproc=itask_cont_to(ii)
6111 c write (iout,*) nn," contacts to processor",iproc,
6112 c & " of CONT_TO_COMM group"
6115 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6116 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6117 c write (iout,*) "ireq,req",ireq,req(ireq)
6119 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6123 c write (iout,*) "number of requests (contacts)",ireq
6124 c write (iout,*) "req",(req(i),i=1,4)
6127 & call MPI_Waitall(ireq,req,status_array,ierr)
6128 do iii=1,ntask_cont_from
6129 iproc=itask_cont_from(iii)
6132 write (iout,*) "Received",nn," contacts from processor",iproc,
6133 & " of CONT_FROM_COMM group"
6136 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6141 ii=zapas_recv(1,i,iii)
6142 c Flag the received contacts to prevent double-counting
6143 jj=-zapas_recv(2,i,iii)
6144 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6146 nnn=num_cont_hb(ii)+1
6149 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6150 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6151 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6152 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6153 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6154 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6155 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6156 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6157 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6158 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6159 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6160 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6161 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6162 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6163 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6164 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6165 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6166 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6167 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6168 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6169 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6170 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6171 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6172 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6177 write (iout,'(a)') 'Contact function values after receive:'
6179 write (iout,'(2i3,50(1x,i3,f5.2))')
6180 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6181 & j=1,num_cont_hb(i))
6188 write (iout,'(a)') 'Contact function values:'
6190 write (iout,'(2i3,50(1x,i3,f5.2))')
6191 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6192 & j=1,num_cont_hb(i))
6196 C Remove the loop below after debugging !!!
6203 C Calculate the local-electrostatic correlation terms
6204 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6206 num_conti=num_cont_hb(i)
6207 num_conti1=num_cont_hb(i+1)
6214 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6215 c & ' jj=',jj,' kk=',kk
6216 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6217 & .or. j.lt.0 .and. j1.gt.0) .and.
6218 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6219 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6220 C The system gains extra energy.
6221 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6222 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6223 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6225 else if (j1.eq.j) then
6226 C Contacts I-J and I-(J+1) occur simultaneously.
6227 C The system loses extra energy.
6228 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6233 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6234 c & ' jj=',jj,' kk=',kk
6236 C Contacts I-J and (I+1)-J occur simultaneously.
6237 C The system loses extra energy.
6238 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6245 c------------------------------------------------------------------------------
6246 subroutine add_hb_contact(ii,jj,itask)
6247 implicit real*8 (a-h,o-z)
6248 include "DIMENSIONS"
6249 include "COMMON.IOUNITS"
6252 parameter (max_cont=maxconts)
6253 parameter (max_dim=26)
6254 include "COMMON.CONTACTS"
6255 double precision zapas(max_dim,maxconts,max_fg_procs),
6256 & zapas_recv(max_dim,maxconts,max_fg_procs)
6257 common /przechowalnia/ zapas
6258 integer i,j,ii,jj,iproc,itask(4),nn
6259 c write (iout,*) "itask",itask
6262 if (iproc.gt.0) then
6263 do j=1,num_cont_hb(ii)
6265 c write (iout,*) "i",ii," j",jj," jjc",jjc
6267 ncont_sent(iproc)=ncont_sent(iproc)+1
6268 nn=ncont_sent(iproc)
6269 zapas(1,nn,iproc)=ii
6270 zapas(2,nn,iproc)=jjc
6271 zapas(3,nn,iproc)=facont_hb(j,ii)
6272 zapas(4,nn,iproc)=ees0p(j,ii)
6273 zapas(5,nn,iproc)=ees0m(j,ii)
6274 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6275 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6276 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6277 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6278 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6279 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6280 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6281 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6282 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6283 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6284 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6285 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6286 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6287 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6288 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6289 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6290 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6291 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6292 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6293 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6294 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6302 c------------------------------------------------------------------------------
6303 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6305 C This subroutine calculates multi-body contributions to hydrogen-bonding
6306 implicit real*8 (a-h,o-z)
6307 include 'DIMENSIONS'
6308 include 'COMMON.IOUNITS'
6311 parameter (max_cont=maxconts)
6312 parameter (max_dim=70)
6313 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6314 double precision zapas(max_dim,maxconts,max_fg_procs),
6315 & zapas_recv(max_dim,maxconts,max_fg_procs)
6316 common /przechowalnia/ zapas
6317 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6318 & status_array(MPI_STATUS_SIZE,maxconts*2)
6320 include 'COMMON.SETUP'
6321 include 'COMMON.FFIELD'
6322 include 'COMMON.DERIV'
6323 include 'COMMON.LOCAL'
6324 include 'COMMON.INTERACT'
6325 include 'COMMON.CONTACTS'
6326 include 'COMMON.CHAIN'
6327 include 'COMMON.CONTROL'
6328 double precision gx(3),gx1(3)
6329 integer num_cont_hb_old(maxres)
6331 double precision eello4,eello5,eelo6,eello_turn6
6332 external eello4,eello5,eello6,eello_turn6
6333 C Set lprn=.true. for debugging
6338 num_cont_hb_old(i)=num_cont_hb(i)
6342 if (nfgtasks.le.1) goto 30
6344 write (iout,'(a)') 'Contact function values before RECEIVE:'
6346 write (iout,'(2i3,50(1x,i2,f5.2))')
6347 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6348 & j=1,num_cont_hb(i))
6352 do i=1,ntask_cont_from
6355 do i=1,ntask_cont_to
6358 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6360 C Make the list of contacts to send to send to other procesors
6361 do i=iturn3_start,iturn3_end
6362 c write (iout,*) "make contact list turn3",i," num_cont",
6364 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6366 do i=iturn4_start,iturn4_end
6367 c write (iout,*) "make contact list turn4",i," num_cont",
6369 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6373 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6375 do j=1,num_cont_hb(i)
6378 iproc=iint_sent_local(k,jjc,ii)
6379 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6380 if (iproc.ne.0) then
6381 ncont_sent(iproc)=ncont_sent(iproc)+1
6382 nn=ncont_sent(iproc)
6384 zapas(2,nn,iproc)=jjc
6385 zapas(3,nn,iproc)=d_cont(j,i)
6389 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6394 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6402 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6413 & "Numbers of contacts to be sent to other processors",
6414 & (ncont_sent(i),i=1,ntask_cont_to)
6415 write (iout,*) "Contacts sent"
6416 do ii=1,ntask_cont_to
6418 iproc=itask_cont_to(ii)
6419 write (iout,*) nn," contacts to processor",iproc,
6420 & " of CONT_TO_COMM group"
6422 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6430 CorrelID1=nfgtasks+fg_rank+1
6432 C Receive the numbers of needed contacts from other processors
6433 do ii=1,ntask_cont_from
6434 iproc=itask_cont_from(ii)
6436 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6437 & FG_COMM,req(ireq),IERR)
6439 c write (iout,*) "IRECV ended"
6441 C Send the number of contacts needed by other processors
6442 do ii=1,ntask_cont_to
6443 iproc=itask_cont_to(ii)
6445 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6446 & FG_COMM,req(ireq),IERR)
6448 c write (iout,*) "ISEND ended"
6449 c write (iout,*) "number of requests (nn)",ireq
6452 & call MPI_Waitall(ireq,req,status_array,ierr)
6454 c & "Numbers of contacts to be received from other processors",
6455 c & (ncont_recv(i),i=1,ntask_cont_from)
6459 do ii=1,ntask_cont_from
6460 iproc=itask_cont_from(ii)
6462 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6463 c & " of CONT_TO_COMM group"
6467 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6468 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6469 c write (iout,*) "ireq,req",ireq,req(ireq)
6472 C Send the contacts to processors that need them
6473 do ii=1,ntask_cont_to
6474 iproc=itask_cont_to(ii)
6476 c write (iout,*) nn," contacts to processor",iproc,
6477 c & " of CONT_TO_COMM group"
6480 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6481 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6482 c write (iout,*) "ireq,req",ireq,req(ireq)
6484 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6488 c write (iout,*) "number of requests (contacts)",ireq
6489 c write (iout,*) "req",(req(i),i=1,4)
6492 & call MPI_Waitall(ireq,req,status_array,ierr)
6493 do iii=1,ntask_cont_from
6494 iproc=itask_cont_from(iii)
6497 write (iout,*) "Received",nn," contacts from processor",iproc,
6498 & " of CONT_FROM_COMM group"
6501 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6506 ii=zapas_recv(1,i,iii)
6507 c Flag the received contacts to prevent double-counting
6508 jj=-zapas_recv(2,i,iii)
6509 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6511 nnn=num_cont_hb(ii)+1
6514 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6518 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6523 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6531 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6540 write (iout,'(a)') 'Contact function values after receive:'
6542 write (iout,'(2i3,50(1x,i3,5f6.3))')
6543 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6544 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6551 write (iout,'(a)') 'Contact function values:'
6553 write (iout,'(2i3,50(1x,i2,5f6.3))')
6554 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6555 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6561 C Remove the loop below after debugging !!!
6568 C Calculate the dipole-dipole interaction energies
6569 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6570 do i=iatel_s,iatel_e+1
6571 num_conti=num_cont_hb(i)
6580 C Calculate the local-electrostatic correlation terms
6581 c write (iout,*) "gradcorr5 in eello5 before loop"
6583 c write (iout,'(i5,3f10.5)')
6584 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6586 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6587 c write (iout,*) "corr loop i",i
6589 num_conti=num_cont_hb(i)
6590 num_conti1=num_cont_hb(i+1)
6597 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6598 c & ' jj=',jj,' kk=',kk
6599 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6600 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6601 & .or. j.lt.0 .and. j1.gt.0) .and.
6602 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6603 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6604 C The system gains extra energy.
6606 sqd1=dsqrt(d_cont(jj,i))
6607 sqd2=dsqrt(d_cont(kk,i1))
6608 sred_geom = sqd1*sqd2
6609 IF (sred_geom.lt.cutoff_corr) THEN
6610 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6612 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6613 cd & ' jj=',jj,' kk=',kk
6614 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6615 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6617 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6618 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6621 cd write (iout,*) 'sred_geom=',sred_geom,
6622 cd & ' ekont=',ekont,' fprim=',fprimcont,
6623 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6624 cd write (iout,*) "g_contij",g_contij
6625 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6626 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6627 call calc_eello(i,jp,i+1,jp1,jj,kk)
6628 if (wcorr4.gt.0.0d0)
6629 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6630 if (energy_dec.and.wcorr4.gt.0.0d0)
6631 1 write (iout,'(a6,4i5,0pf7.3)')
6632 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6633 c write (iout,*) "gradcorr5 before eello5"
6635 c write (iout,'(i5,3f10.5)')
6636 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6638 if (wcorr5.gt.0.0d0)
6639 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6640 c write (iout,*) "gradcorr5 after eello5"
6642 c write (iout,'(i5,3f10.5)')
6643 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6645 if (energy_dec.and.wcorr5.gt.0.0d0)
6646 1 write (iout,'(a6,4i5,0pf7.3)')
6647 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6648 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6649 cd write(2,*)'ijkl',i,jp,i+1,jp1
6650 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6651 & .or. wturn6.eq.0.0d0))then
6652 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6653 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6654 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6655 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6656 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6657 cd & 'ecorr6=',ecorr6
6658 cd write (iout,'(4e15.5)') sred_geom,
6659 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6660 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6661 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6662 else if (wturn6.gt.0.0d0
6663 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6664 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6665 eturn6=eturn6+eello_turn6(i,jj,kk)
6666 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6667 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6668 cd write (2,*) 'multibody_eello:eturn6',eturn6
6677 num_cont_hb(i)=num_cont_hb_old(i)
6679 c write (iout,*) "gradcorr5 in eello5"
6681 c write (iout,'(i5,3f10.5)')
6682 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6686 c------------------------------------------------------------------------------
6687 subroutine add_hb_contact_eello(ii,jj,itask)
6688 implicit real*8 (a-h,o-z)
6689 include "DIMENSIONS"
6690 include "COMMON.IOUNITS"
6693 parameter (max_cont=maxconts)
6694 parameter (max_dim=70)
6695 include "COMMON.CONTACTS"
6696 double precision zapas(max_dim,maxconts,max_fg_procs),
6697 & zapas_recv(max_dim,maxconts,max_fg_procs)
6698 common /przechowalnia/ zapas
6699 integer i,j,ii,jj,iproc,itask(4),nn
6700 c write (iout,*) "itask",itask
6703 if (iproc.gt.0) then
6704 do j=1,num_cont_hb(ii)
6706 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6708 ncont_sent(iproc)=ncont_sent(iproc)+1
6709 nn=ncont_sent(iproc)
6710 zapas(1,nn,iproc)=ii
6711 zapas(2,nn,iproc)=jjc
6712 zapas(3,nn,iproc)=d_cont(j,ii)
6716 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6721 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6729 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6741 c------------------------------------------------------------------------------
6742 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6743 implicit real*8 (a-h,o-z)
6744 include 'DIMENSIONS'
6745 include 'COMMON.IOUNITS'
6746 include 'COMMON.DERIV'
6747 include 'COMMON.INTERACT'
6748 include 'COMMON.CONTACTS'
6749 double precision gx(3),gx1(3)
6759 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6760 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6761 C Following 4 lines for diagnostics.
6766 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6767 c & 'Contacts ',i,j,
6768 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6769 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6771 C Calculate the multi-body contribution to energy.
6772 c ecorr=ecorr+ekont*ees
6773 C Calculate multi-body contributions to the gradient.
6774 coeffpees0pij=coeffp*ees0pij
6775 coeffmees0mij=coeffm*ees0mij
6776 coeffpees0pkl=coeffp*ees0pkl
6777 coeffmees0mkl=coeffm*ees0mkl
6779 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6780 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6781 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6782 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6783 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6784 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6785 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6786 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6787 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6788 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6789 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6790 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6791 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6792 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6793 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6794 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6795 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6796 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6797 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6798 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6799 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6800 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6801 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6802 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6803 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6808 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6809 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6810 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6811 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6816 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6817 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6818 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6819 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6822 c write (iout,*) "ehbcorr",ekont*ees
6827 C---------------------------------------------------------------------------
6828 subroutine dipole(i,j,jj)
6829 implicit real*8 (a-h,o-z)
6830 include 'DIMENSIONS'
6831 include 'COMMON.IOUNITS'
6832 include 'COMMON.CHAIN'
6833 include 'COMMON.FFIELD'
6834 include 'COMMON.DERIV'
6835 include 'COMMON.INTERACT'
6836 include 'COMMON.CONTACTS'
6837 include 'COMMON.TORSION'
6838 include 'COMMON.VAR'
6839 include 'COMMON.GEO'
6840 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6842 iti1 = itortyp(itype(i+1))
6843 if (j.lt.nres-1) then
6844 itj1 = itortyp(itype(j+1))
6849 dipi(iii,1)=Ub2(iii,i)
6850 dipderi(iii)=Ub2der(iii,i)
6851 dipi(iii,2)=b1(iii,iti1)
6852 dipj(iii,1)=Ub2(iii,j)
6853 dipderj(iii)=Ub2der(iii,j)
6854 dipj(iii,2)=b1(iii,itj1)
6858 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6861 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6868 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6872 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6877 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6878 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6880 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6882 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6884 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6889 C---------------------------------------------------------------------------
6890 subroutine calc_eello(i,j,k,l,jj,kk)
6892 C This subroutine computes matrices and vectors needed to calculate
6893 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6895 implicit real*8 (a-h,o-z)
6896 include 'DIMENSIONS'
6897 include 'COMMON.IOUNITS'
6898 include 'COMMON.CHAIN'
6899 include 'COMMON.DERIV'
6900 include 'COMMON.INTERACT'
6901 include 'COMMON.CONTACTS'
6902 include 'COMMON.TORSION'
6903 include 'COMMON.VAR'
6904 include 'COMMON.GEO'
6905 include 'COMMON.FFIELD'
6906 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6907 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6910 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6911 cd & ' jj=',jj,' kk=',kk
6912 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6913 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6914 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6917 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6918 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6921 call transpose2(aa1(1,1),aa1t(1,1))
6922 call transpose2(aa2(1,1),aa2t(1,1))
6925 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6926 & aa1tder(1,1,lll,kkk))
6927 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6928 & aa2tder(1,1,lll,kkk))
6932 C parallel orientation of the two CA-CA-CA frames.
6934 iti=itortyp(itype(i))
6938 itk1=itortyp(itype(k+1))
6939 itj=itortyp(itype(j))
6940 if (l.lt.nres-1) then
6941 itl1=itortyp(itype(l+1))
6945 C A1 kernel(j+1) A2T
6947 cd write (iout,'(3f10.5,5x,3f10.5)')
6948 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6950 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6951 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6952 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6953 C Following matrices are needed only for 6-th order cumulants
6954 IF (wcorr6.gt.0.0d0) THEN
6955 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6956 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6957 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6958 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6959 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6960 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6961 & ADtEAderx(1,1,1,1,1,1))
6963 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6964 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6965 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6966 & ADtEA1derx(1,1,1,1,1,1))
6968 C End 6-th order cumulants
6971 cd write (2,*) 'In calc_eello6'
6973 cd write (2,*) 'iii=',iii
6975 cd write (2,*) 'kkk=',kkk
6977 cd write (2,'(3(2f10.5),5x)')
6978 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6983 call transpose2(EUgder(1,1,k),auxmat(1,1))
6984 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6985 call transpose2(EUg(1,1,k),auxmat(1,1))
6986 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6987 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6991 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6992 & EAEAderx(1,1,lll,kkk,iii,1))
6996 C A1T kernel(i+1) A2
6997 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6998 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6999 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7000 C Following matrices are needed only for 6-th order cumulants
7001 IF (wcorr6.gt.0.0d0) THEN
7002 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7003 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7004 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7005 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7006 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7007 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7008 & ADtEAderx(1,1,1,1,1,2))
7009 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7010 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7011 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7012 & ADtEA1derx(1,1,1,1,1,2))
7014 C End 6-th order cumulants
7015 call transpose2(EUgder(1,1,l),auxmat(1,1))
7016 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7017 call transpose2(EUg(1,1,l),auxmat(1,1))
7018 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7019 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7023 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7024 & EAEAderx(1,1,lll,kkk,iii,2))
7029 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7030 C They are needed only when the fifth- or the sixth-order cumulants are
7032 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7033 call transpose2(AEA(1,1,1),auxmat(1,1))
7034 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7035 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7036 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7037 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7038 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7039 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7040 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7041 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7042 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7043 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7044 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7045 call transpose2(AEA(1,1,2),auxmat(1,1))
7046 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7047 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7048 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7049 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7050 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7051 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7052 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7053 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7054 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7055 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7056 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7057 C Calculate the Cartesian derivatives of the vectors.
7061 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7062 call matvec2(auxmat(1,1),b1(1,iti),
7063 & AEAb1derx(1,lll,kkk,iii,1,1))
7064 call matvec2(auxmat(1,1),Ub2(1,i),
7065 & AEAb2derx(1,lll,kkk,iii,1,1))
7066 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7067 & AEAb1derx(1,lll,kkk,iii,2,1))
7068 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7069 & AEAb2derx(1,lll,kkk,iii,2,1))
7070 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7071 call matvec2(auxmat(1,1),b1(1,itj),
7072 & AEAb1derx(1,lll,kkk,iii,1,2))
7073 call matvec2(auxmat(1,1),Ub2(1,j),
7074 & AEAb2derx(1,lll,kkk,iii,1,2))
7075 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7076 & AEAb1derx(1,lll,kkk,iii,2,2))
7077 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7078 & AEAb2derx(1,lll,kkk,iii,2,2))
7085 C Antiparallel orientation of the two CA-CA-CA frames.
7087 iti=itortyp(itype(i))
7091 itk1=itortyp(itype(k+1))
7092 itl=itortyp(itype(l))
7093 itj=itortyp(itype(j))
7094 if (j.lt.nres-1) then
7095 itj1=itortyp(itype(j+1))
7099 C A2 kernel(j-1)T A1T
7100 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7101 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7102 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7103 C Following matrices are needed only for 6-th order cumulants
7104 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7105 & j.eq.i+4 .and. l.eq.i+3)) THEN
7106 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7107 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7108 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7109 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7110 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7111 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7112 & ADtEAderx(1,1,1,1,1,1))
7113 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7114 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7115 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7116 & ADtEA1derx(1,1,1,1,1,1))
7118 C End 6-th order cumulants
7119 call transpose2(EUgder(1,1,k),auxmat(1,1))
7120 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7121 call transpose2(EUg(1,1,k),auxmat(1,1))
7122 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7123 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7127 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7128 & EAEAderx(1,1,lll,kkk,iii,1))
7132 C A2T kernel(i+1)T A1
7133 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7134 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7135 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7136 C Following matrices are needed only for 6-th order cumulants
7137 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7138 & j.eq.i+4 .and. l.eq.i+3)) THEN
7139 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7140 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7141 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7142 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7143 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7144 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7145 & ADtEAderx(1,1,1,1,1,2))
7146 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7147 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7148 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7149 & ADtEA1derx(1,1,1,1,1,2))
7151 C End 6-th order cumulants
7152 call transpose2(EUgder(1,1,j),auxmat(1,1))
7153 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7154 call transpose2(EUg(1,1,j),auxmat(1,1))
7155 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7156 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7160 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7161 & EAEAderx(1,1,lll,kkk,iii,2))
7166 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7167 C They are needed only when the fifth- or the sixth-order cumulants are
7169 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7170 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7171 call transpose2(AEA(1,1,1),auxmat(1,1))
7172 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7173 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7174 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7175 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7176 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7177 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7178 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7179 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7180 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7181 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7182 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7183 call transpose2(AEA(1,1,2),auxmat(1,1))
7184 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7185 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7186 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7187 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7188 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7189 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7190 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7191 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7192 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7193 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7194 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7195 C Calculate the Cartesian derivatives of the vectors.
7199 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7200 call matvec2(auxmat(1,1),b1(1,iti),
7201 & AEAb1derx(1,lll,kkk,iii,1,1))
7202 call matvec2(auxmat(1,1),Ub2(1,i),
7203 & AEAb2derx(1,lll,kkk,iii,1,1))
7204 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7205 & AEAb1derx(1,lll,kkk,iii,2,1))
7206 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7207 & AEAb2derx(1,lll,kkk,iii,2,1))
7208 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7209 call matvec2(auxmat(1,1),b1(1,itl),
7210 & AEAb1derx(1,lll,kkk,iii,1,2))
7211 call matvec2(auxmat(1,1),Ub2(1,l),
7212 & AEAb2derx(1,lll,kkk,iii,1,2))
7213 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7214 & AEAb1derx(1,lll,kkk,iii,2,2))
7215 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7216 & AEAb2derx(1,lll,kkk,iii,2,2))
7225 C---------------------------------------------------------------------------
7226 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7227 & KK,KKderg,AKA,AKAderg,AKAderx)
7231 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7232 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7233 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7238 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7240 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7243 cd if (lprn) write (2,*) 'In kernel'
7245 cd if (lprn) write (2,*) 'kkk=',kkk
7247 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7248 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7250 cd write (2,*) 'lll=',lll
7251 cd write (2,*) 'iii=1'
7253 cd write (2,'(3(2f10.5),5x)')
7254 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7257 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7258 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7260 cd write (2,*) 'lll=',lll
7261 cd write (2,*) 'iii=2'
7263 cd write (2,'(3(2f10.5),5x)')
7264 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7271 C---------------------------------------------------------------------------
7272 double precision function eello4(i,j,k,l,jj,kk)
7273 implicit real*8 (a-h,o-z)
7274 include 'DIMENSIONS'
7275 include 'COMMON.IOUNITS'
7276 include 'COMMON.CHAIN'
7277 include 'COMMON.DERIV'
7278 include 'COMMON.INTERACT'
7279 include 'COMMON.CONTACTS'
7280 include 'COMMON.TORSION'
7281 include 'COMMON.VAR'
7282 include 'COMMON.GEO'
7283 double precision pizda(2,2),ggg1(3),ggg2(3)
7284 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7288 cd print *,'eello4:',i,j,k,l,jj,kk
7289 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7290 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7291 cold eij=facont_hb(jj,i)
7292 cold ekl=facont_hb(kk,k)
7294 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7295 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7296 gcorr_loc(k-1)=gcorr_loc(k-1)
7297 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7299 gcorr_loc(l-1)=gcorr_loc(l-1)
7300 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7302 gcorr_loc(j-1)=gcorr_loc(j-1)
7303 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7308 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7309 & -EAEAderx(2,2,lll,kkk,iii,1)
7310 cd derx(lll,kkk,iii)=0.0d0
7314 cd gcorr_loc(l-1)=0.0d0
7315 cd gcorr_loc(j-1)=0.0d0
7316 cd gcorr_loc(k-1)=0.0d0
7318 cd write (iout,*)'Contacts have occurred for peptide groups',
7319 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7320 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7321 if (j.lt.nres-1) then
7328 if (l.lt.nres-1) then
7336 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7337 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7338 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7339 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7340 cgrad ghalf=0.5d0*ggg1(ll)
7341 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7342 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7343 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7344 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7345 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7346 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7347 cgrad ghalf=0.5d0*ggg2(ll)
7348 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7349 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7350 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7351 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7352 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7353 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7357 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7362 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7367 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7372 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7376 cd write (2,*) iii,gcorr_loc(iii)
7379 cd write (2,*) 'ekont',ekont
7380 cd write (iout,*) 'eello4',ekont*eel4
7383 C---------------------------------------------------------------------------
7384 double precision function eello5(i,j,k,l,jj,kk)
7385 implicit real*8 (a-h,o-z)
7386 include 'DIMENSIONS'
7387 include 'COMMON.IOUNITS'
7388 include 'COMMON.CHAIN'
7389 include 'COMMON.DERIV'
7390 include 'COMMON.INTERACT'
7391 include 'COMMON.CONTACTS'
7392 include 'COMMON.TORSION'
7393 include 'COMMON.VAR'
7394 include 'COMMON.GEO'
7395 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7396 double precision ggg1(3),ggg2(3)
7397 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7402 C /l\ / \ \ / \ / \ / C
7403 C / \ / \ \ / \ / \ / C
7404 C j| o |l1 | o | o| o | | o |o C
7405 C \ |/k\| |/ \| / |/ \| |/ \| C
7406 C \i/ \ / \ / / \ / \ C
7408 C (I) (II) (III) (IV) C
7410 C eello5_1 eello5_2 eello5_3 eello5_4 C
7412 C Antiparallel chains C
7415 C /j\ / \ \ / \ / \ / C
7416 C / \ / \ \ / \ / \ / C
7417 C j1| o |l | o | o| o | | o |o C
7418 C \ |/k\| |/ \| / |/ \| |/ \| C
7419 C \i/ \ / \ / / \ / \ C
7421 C (I) (II) (III) (IV) C
7423 C eello5_1 eello5_2 eello5_3 eello5_4 C
7425 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7427 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7428 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7433 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7435 itk=itortyp(itype(k))
7436 itl=itortyp(itype(l))
7437 itj=itortyp(itype(j))
7442 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7443 cd & eel5_3_num,eel5_4_num)
7447 derx(lll,kkk,iii)=0.0d0
7451 cd eij=facont_hb(jj,i)
7452 cd ekl=facont_hb(kk,k)
7454 cd write (iout,*)'Contacts have occurred for peptide groups',
7455 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7457 C Contribution from the graph I.
7458 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7459 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7460 call transpose2(EUg(1,1,k),auxmat(1,1))
7461 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7462 vv(1)=pizda(1,1)-pizda(2,2)
7463 vv(2)=pizda(1,2)+pizda(2,1)
7464 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7465 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7466 C Explicit gradient in virtual-dihedral angles.
7467 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7468 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7469 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7470 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7471 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7472 vv(1)=pizda(1,1)-pizda(2,2)
7473 vv(2)=pizda(1,2)+pizda(2,1)
7474 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7475 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7476 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7477 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7478 vv(1)=pizda(1,1)-pizda(2,2)
7479 vv(2)=pizda(1,2)+pizda(2,1)
7481 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7482 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7483 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7485 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7486 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7487 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7489 C Cartesian gradient
7493 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7495 vv(1)=pizda(1,1)-pizda(2,2)
7496 vv(2)=pizda(1,2)+pizda(2,1)
7497 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7498 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7499 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7505 C Contribution from graph II
7506 call transpose2(EE(1,1,itk),auxmat(1,1))
7507 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7508 vv(1)=pizda(1,1)+pizda(2,2)
7509 vv(2)=pizda(2,1)-pizda(1,2)
7510 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7511 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7512 C Explicit gradient in virtual-dihedral angles.
7513 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7514 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7515 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7516 vv(1)=pizda(1,1)+pizda(2,2)
7517 vv(2)=pizda(2,1)-pizda(1,2)
7519 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7520 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7521 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7523 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7524 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7525 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7527 C Cartesian gradient
7531 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7533 vv(1)=pizda(1,1)+pizda(2,2)
7534 vv(2)=pizda(2,1)-pizda(1,2)
7535 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7536 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7537 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7545 C Parallel orientation
7546 C Contribution from graph III
7547 call transpose2(EUg(1,1,l),auxmat(1,1))
7548 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7549 vv(1)=pizda(1,1)-pizda(2,2)
7550 vv(2)=pizda(1,2)+pizda(2,1)
7551 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7552 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7553 C Explicit gradient in virtual-dihedral angles.
7554 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7555 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7556 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7557 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7558 vv(1)=pizda(1,1)-pizda(2,2)
7559 vv(2)=pizda(1,2)+pizda(2,1)
7560 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7561 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7562 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7563 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7564 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7565 vv(1)=pizda(1,1)-pizda(2,2)
7566 vv(2)=pizda(1,2)+pizda(2,1)
7567 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7568 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7569 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7570 C Cartesian gradient
7574 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7576 vv(1)=pizda(1,1)-pizda(2,2)
7577 vv(2)=pizda(1,2)+pizda(2,1)
7578 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7579 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7580 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7585 C Contribution from graph IV
7587 call transpose2(EE(1,1,itl),auxmat(1,1))
7588 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7589 vv(1)=pizda(1,1)+pizda(2,2)
7590 vv(2)=pizda(2,1)-pizda(1,2)
7591 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7592 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7593 C Explicit gradient in virtual-dihedral angles.
7594 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7595 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7596 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7597 vv(1)=pizda(1,1)+pizda(2,2)
7598 vv(2)=pizda(2,1)-pizda(1,2)
7599 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7600 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7601 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7602 C Cartesian gradient
7606 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7608 vv(1)=pizda(1,1)+pizda(2,2)
7609 vv(2)=pizda(2,1)-pizda(1,2)
7610 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7611 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7612 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7617 C Antiparallel orientation
7618 C Contribution from graph III
7620 call transpose2(EUg(1,1,j),auxmat(1,1))
7621 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7622 vv(1)=pizda(1,1)-pizda(2,2)
7623 vv(2)=pizda(1,2)+pizda(2,1)
7624 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7625 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7626 C Explicit gradient in virtual-dihedral angles.
7627 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7628 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7629 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7630 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7631 vv(1)=pizda(1,1)-pizda(2,2)
7632 vv(2)=pizda(1,2)+pizda(2,1)
7633 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7634 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7635 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7636 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7637 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7638 vv(1)=pizda(1,1)-pizda(2,2)
7639 vv(2)=pizda(1,2)+pizda(2,1)
7640 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7641 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7642 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7643 C Cartesian gradient
7647 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7649 vv(1)=pizda(1,1)-pizda(2,2)
7650 vv(2)=pizda(1,2)+pizda(2,1)
7651 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7652 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7653 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7658 C Contribution from graph IV
7660 call transpose2(EE(1,1,itj),auxmat(1,1))
7661 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7662 vv(1)=pizda(1,1)+pizda(2,2)
7663 vv(2)=pizda(2,1)-pizda(1,2)
7664 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7665 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7666 C Explicit gradient in virtual-dihedral angles.
7667 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7668 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7669 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7670 vv(1)=pizda(1,1)+pizda(2,2)
7671 vv(2)=pizda(2,1)-pizda(1,2)
7672 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7673 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7674 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7675 C Cartesian gradient
7679 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7681 vv(1)=pizda(1,1)+pizda(2,2)
7682 vv(2)=pizda(2,1)-pizda(1,2)
7683 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7684 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7685 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7691 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7692 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7693 cd write (2,*) 'ijkl',i,j,k,l
7694 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7695 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7697 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7698 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7699 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7700 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7701 if (j.lt.nres-1) then
7708 if (l.lt.nres-1) then
7718 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7719 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7720 C summed up outside the subrouine as for the other subroutines
7721 C handling long-range interactions. The old code is commented out
7722 C with "cgrad" to keep track of changes.
7724 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7725 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7726 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7727 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7728 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7729 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7730 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7731 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7732 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7733 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7735 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7736 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7737 cgrad ghalf=0.5d0*ggg1(ll)
7739 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7740 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7741 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7742 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7743 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7744 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7745 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7746 cgrad ghalf=0.5d0*ggg2(ll)
7748 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7749 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7750 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7751 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7752 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7753 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7758 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7759 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7764 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7765 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7771 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7776 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7780 cd write (2,*) iii,g_corr5_loc(iii)
7783 cd write (2,*) 'ekont',ekont
7784 cd write (iout,*) 'eello5',ekont*eel5
7787 c--------------------------------------------------------------------------
7788 double precision function eello6(i,j,k,l,jj,kk)
7789 implicit real*8 (a-h,o-z)
7790 include 'DIMENSIONS'
7791 include 'COMMON.IOUNITS'
7792 include 'COMMON.CHAIN'
7793 include 'COMMON.DERIV'
7794 include 'COMMON.INTERACT'
7795 include 'COMMON.CONTACTS'
7796 include 'COMMON.TORSION'
7797 include 'COMMON.VAR'
7798 include 'COMMON.GEO'
7799 include 'COMMON.FFIELD'
7800 double precision ggg1(3),ggg2(3)
7801 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7806 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7814 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7815 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7819 derx(lll,kkk,iii)=0.0d0
7823 cd eij=facont_hb(jj,i)
7824 cd ekl=facont_hb(kk,k)
7830 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7831 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7832 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7833 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7834 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7835 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7837 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7838 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7839 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7840 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7841 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7842 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7846 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7848 C If turn contributions are considered, they will be handled separately.
7849 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7850 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7851 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7852 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7853 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7854 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7855 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7857 if (j.lt.nres-1) then
7864 if (l.lt.nres-1) then
7872 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7873 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7874 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7875 cgrad ghalf=0.5d0*ggg1(ll)
7877 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7878 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7879 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7880 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7881 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7882 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7883 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7884 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7885 cgrad ghalf=0.5d0*ggg2(ll)
7886 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7888 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7889 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7890 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7891 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7892 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7893 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7898 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7899 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7904 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7905 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7911 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7916 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7920 cd write (2,*) iii,g_corr6_loc(iii)
7923 cd write (2,*) 'ekont',ekont
7924 cd write (iout,*) 'eello6',ekont*eel6
7927 c--------------------------------------------------------------------------
7928 double precision function eello6_graph1(i,j,k,l,imat,swap)
7929 implicit real*8 (a-h,o-z)
7930 include 'DIMENSIONS'
7931 include 'COMMON.IOUNITS'
7932 include 'COMMON.CHAIN'
7933 include 'COMMON.DERIV'
7934 include 'COMMON.INTERACT'
7935 include 'COMMON.CONTACTS'
7936 include 'COMMON.TORSION'
7937 include 'COMMON.VAR'
7938 include 'COMMON.GEO'
7939 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7943 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7945 C Parallel Antiparallel C
7951 C \ j|/k\| / \ |/k\|l / C
7956 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7957 itk=itortyp(itype(k))
7958 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7959 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7960 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7961 call transpose2(EUgC(1,1,k),auxmat(1,1))
7962 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7963 vv1(1)=pizda1(1,1)-pizda1(2,2)
7964 vv1(2)=pizda1(1,2)+pizda1(2,1)
7965 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7966 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7967 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7968 s5=scalar2(vv(1),Dtobr2(1,i))
7969 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7970 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7971 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7972 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7973 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7974 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7975 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7976 & +scalar2(vv(1),Dtobr2der(1,i)))
7977 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7978 vv1(1)=pizda1(1,1)-pizda1(2,2)
7979 vv1(2)=pizda1(1,2)+pizda1(2,1)
7980 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7981 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7983 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7984 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7985 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7986 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7987 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7989 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7990 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7991 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7992 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7993 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7995 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7996 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7997 vv1(1)=pizda1(1,1)-pizda1(2,2)
7998 vv1(2)=pizda1(1,2)+pizda1(2,1)
7999 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8000 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8001 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8002 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8011 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8012 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8013 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8014 call transpose2(EUgC(1,1,k),auxmat(1,1))
8015 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8017 vv1(1)=pizda1(1,1)-pizda1(2,2)
8018 vv1(2)=pizda1(1,2)+pizda1(2,1)
8019 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8020 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8021 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8022 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8023 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8024 s5=scalar2(vv(1),Dtobr2(1,i))
8025 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8031 c----------------------------------------------------------------------------
8032 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8033 implicit real*8 (a-h,o-z)
8034 include 'DIMENSIONS'
8035 include 'COMMON.IOUNITS'
8036 include 'COMMON.CHAIN'
8037 include 'COMMON.DERIV'
8038 include 'COMMON.INTERACT'
8039 include 'COMMON.CONTACTS'
8040 include 'COMMON.TORSION'
8041 include 'COMMON.VAR'
8042 include 'COMMON.GEO'
8044 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8045 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8048 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8050 C Parallel Antiparallel C
8056 C \ j|/k\| \ |/k\|l C
8061 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8062 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8063 C AL 7/4/01 s1 would occur in the sixth-order moment,
8064 C but not in a cluster cumulant
8066 s1=dip(1,jj,i)*dip(1,kk,k)
8068 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8069 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8070 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8071 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8072 call transpose2(EUg(1,1,k),auxmat(1,1))
8073 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8074 vv(1)=pizda(1,1)-pizda(2,2)
8075 vv(2)=pizda(1,2)+pizda(2,1)
8076 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8077 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8079 eello6_graph2=-(s1+s2+s3+s4)
8081 eello6_graph2=-(s2+s3+s4)
8084 C Derivatives in gamma(i-1)
8087 s1=dipderg(1,jj,i)*dip(1,kk,k)
8089 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8090 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8091 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8092 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8094 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8096 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8098 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8100 C Derivatives in gamma(k-1)
8102 s1=dip(1,jj,i)*dipderg(1,kk,k)
8104 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8105 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8106 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8107 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8108 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8109 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8110 vv(1)=pizda(1,1)-pizda(2,2)
8111 vv(2)=pizda(1,2)+pizda(2,1)
8112 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8114 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8116 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8118 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8119 C Derivatives in gamma(j-1) or gamma(l-1)
8122 s1=dipderg(3,jj,i)*dip(1,kk,k)
8124 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8125 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8126 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8127 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8128 vv(1)=pizda(1,1)-pizda(2,2)
8129 vv(2)=pizda(1,2)+pizda(2,1)
8130 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8133 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8135 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8138 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8139 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8141 C Derivatives in gamma(l-1) or gamma(j-1)
8144 s1=dip(1,jj,i)*dipderg(3,kk,k)
8146 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8147 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8148 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8149 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8150 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8151 vv(1)=pizda(1,1)-pizda(2,2)
8152 vv(2)=pizda(1,2)+pizda(2,1)
8153 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8156 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8158 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8161 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8162 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8164 C Cartesian derivatives.
8166 write (2,*) 'In eello6_graph2'
8168 write (2,*) 'iii=',iii
8170 write (2,*) 'kkk=',kkk
8172 write (2,'(3(2f10.5),5x)')
8173 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8183 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8185 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8188 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8190 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8191 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8193 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8194 call transpose2(EUg(1,1,k),auxmat(1,1))
8195 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8197 vv(1)=pizda(1,1)-pizda(2,2)
8198 vv(2)=pizda(1,2)+pizda(2,1)
8199 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8200 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8202 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8204 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8207 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8209 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8216 c----------------------------------------------------------------------------
8217 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8218 implicit real*8 (a-h,o-z)
8219 include 'DIMENSIONS'
8220 include 'COMMON.IOUNITS'
8221 include 'COMMON.CHAIN'
8222 include 'COMMON.DERIV'
8223 include 'COMMON.INTERACT'
8224 include 'COMMON.CONTACTS'
8225 include 'COMMON.TORSION'
8226 include 'COMMON.VAR'
8227 include 'COMMON.GEO'
8228 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8230 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8232 C Parallel Antiparallel C
8238 C j|/k\| / |/k\|l / C
8243 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8245 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8246 C energy moment and not to the cluster cumulant.
8247 iti=itortyp(itype(i))
8248 if (j.lt.nres-1) then
8249 itj1=itortyp(itype(j+1))
8253 itk=itortyp(itype(k))
8254 itk1=itortyp(itype(k+1))
8255 if (l.lt.nres-1) then
8256 itl1=itortyp(itype(l+1))
8261 s1=dip(4,jj,i)*dip(4,kk,k)
8263 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8264 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8265 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8266 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8267 call transpose2(EE(1,1,itk),auxmat(1,1))
8268 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8269 vv(1)=pizda(1,1)+pizda(2,2)
8270 vv(2)=pizda(2,1)-pizda(1,2)
8271 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8272 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8273 cd & "sum",-(s2+s3+s4)
8275 eello6_graph3=-(s1+s2+s3+s4)
8277 eello6_graph3=-(s2+s3+s4)
8280 C Derivatives in gamma(k-1)
8281 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8282 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8283 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8284 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8285 C Derivatives in gamma(l-1)
8286 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8287 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8288 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8289 vv(1)=pizda(1,1)+pizda(2,2)
8290 vv(2)=pizda(2,1)-pizda(1,2)
8291 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8292 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8293 C Cartesian derivatives.
8299 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8301 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8304 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8306 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8307 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8309 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8310 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8312 vv(1)=pizda(1,1)+pizda(2,2)
8313 vv(2)=pizda(2,1)-pizda(1,2)
8314 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8316 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8318 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8321 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8323 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8325 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8331 c----------------------------------------------------------------------------
8332 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8333 implicit real*8 (a-h,o-z)
8334 include 'DIMENSIONS'
8335 include 'COMMON.IOUNITS'
8336 include 'COMMON.CHAIN'
8337 include 'COMMON.DERIV'
8338 include 'COMMON.INTERACT'
8339 include 'COMMON.CONTACTS'
8340 include 'COMMON.TORSION'
8341 include 'COMMON.VAR'
8342 include 'COMMON.GEO'
8343 include 'COMMON.FFIELD'
8344 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8345 & auxvec1(2),auxmat1(2,2)
8347 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8349 C Parallel Antiparallel C
8355 C \ j|/k\| \ |/k\|l C
8360 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8362 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8363 C energy moment and not to the cluster cumulant.
8364 cd write (2,*) 'eello_graph4: wturn6',wturn6
8365 iti=itortyp(itype(i))
8366 itj=itortyp(itype(j))
8367 if (j.lt.nres-1) then
8368 itj1=itortyp(itype(j+1))
8372 itk=itortyp(itype(k))
8373 if (k.lt.nres-1) then
8374 itk1=itortyp(itype(k+1))
8378 itl=itortyp(itype(l))
8379 if (l.lt.nres-1) then
8380 itl1=itortyp(itype(l+1))
8384 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8385 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8386 cd & ' itl',itl,' itl1',itl1
8389 s1=dip(3,jj,i)*dip(3,kk,k)
8391 s1=dip(2,jj,j)*dip(2,kk,l)
8394 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8395 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8397 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8398 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8400 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8401 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8403 call transpose2(EUg(1,1,k),auxmat(1,1))
8404 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8405 vv(1)=pizda(1,1)-pizda(2,2)
8406 vv(2)=pizda(2,1)+pizda(1,2)
8407 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8408 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8410 eello6_graph4=-(s1+s2+s3+s4)
8412 eello6_graph4=-(s2+s3+s4)
8414 C Derivatives in gamma(i-1)
8418 s1=dipderg(2,jj,i)*dip(3,kk,k)
8420 s1=dipderg(4,jj,j)*dip(2,kk,l)
8423 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8425 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8426 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8428 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8429 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8431 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8432 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8433 cd write (2,*) 'turn6 derivatives'
8435 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8437 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8441 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8443 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8447 C Derivatives in gamma(k-1)
8450 s1=dip(3,jj,i)*dipderg(2,kk,k)
8452 s1=dip(2,jj,j)*dipderg(4,kk,l)
8455 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8456 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8458 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8459 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8461 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8462 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8464 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8465 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8466 vv(1)=pizda(1,1)-pizda(2,2)
8467 vv(2)=pizda(2,1)+pizda(1,2)
8468 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8469 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8471 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8473 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8477 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8479 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8482 C Derivatives in gamma(j-1) or gamma(l-1)
8483 if (l.eq.j+1 .and. l.gt.1) then
8484 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8485 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8486 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8487 vv(1)=pizda(1,1)-pizda(2,2)
8488 vv(2)=pizda(2,1)+pizda(1,2)
8489 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8490 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8491 else if (j.gt.1) then
8492 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8493 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8494 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8495 vv(1)=pizda(1,1)-pizda(2,2)
8496 vv(2)=pizda(2,1)+pizda(1,2)
8497 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8498 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8499 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8501 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8504 C Cartesian derivatives.
8511 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8513 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8517 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8519 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8523 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8525 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8527 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8528 & b1(1,itj1),auxvec(1))
8529 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8531 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8532 & b1(1,itl1),auxvec(1))
8533 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8535 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8537 vv(1)=pizda(1,1)-pizda(2,2)
8538 vv(2)=pizda(2,1)+pizda(1,2)
8539 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8541 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8543 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8546 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8549 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8552 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8554 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8556 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8560 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8562 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8565 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8567 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8575 c----------------------------------------------------------------------------
8576 double precision function eello_turn6(i,jj,kk)
8577 implicit real*8 (a-h,o-z)
8578 include 'DIMENSIONS'
8579 include 'COMMON.IOUNITS'
8580 include 'COMMON.CHAIN'
8581 include 'COMMON.DERIV'
8582 include 'COMMON.INTERACT'
8583 include 'COMMON.CONTACTS'
8584 include 'COMMON.TORSION'
8585 include 'COMMON.VAR'
8586 include 'COMMON.GEO'
8587 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8588 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8590 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8591 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8592 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8593 C the respective energy moment and not to the cluster cumulant.
8602 iti=itortyp(itype(i))
8603 itk=itortyp(itype(k))
8604 itk1=itortyp(itype(k+1))
8605 itl=itortyp(itype(l))
8606 itj=itortyp(itype(j))
8607 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8608 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8609 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8614 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8616 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8620 derx_turn(lll,kkk,iii)=0.0d0
8627 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8629 cd write (2,*) 'eello6_5',eello6_5
8631 call transpose2(AEA(1,1,1),auxmat(1,1))
8632 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8633 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8634 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8636 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8637 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8638 s2 = scalar2(b1(1,itk),vtemp1(1))
8640 call transpose2(AEA(1,1,2),atemp(1,1))
8641 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8642 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8643 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8645 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8646 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8647 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8649 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8650 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8651 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8652 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8653 ss13 = scalar2(b1(1,itk),vtemp4(1))
8654 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8656 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8662 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8663 C Derivatives in gamma(i+2)
8667 call transpose2(AEA(1,1,1),auxmatd(1,1))
8668 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8669 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8670 call transpose2(AEAderg(1,1,2),atempd(1,1))
8671 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8672 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8674 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8675 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8676 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8682 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8683 C Derivatives in gamma(i+3)
8685 call transpose2(AEA(1,1,1),auxmatd(1,1))
8686 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8687 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8688 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8690 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8691 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8692 s2d = scalar2(b1(1,itk),vtemp1d(1))
8694 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8695 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8697 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8699 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8700 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8701 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8709 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8710 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8712 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8713 & -0.5d0*ekont*(s2d+s12d)
8715 C Derivatives in gamma(i+4)
8716 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8717 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8718 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8720 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8721 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8722 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8730 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8732 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8734 C Derivatives in gamma(i+5)
8736 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8737 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8738 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8740 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8741 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8742 s2d = scalar2(b1(1,itk),vtemp1d(1))
8744 call transpose2(AEA(1,1,2),atempd(1,1))
8745 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8746 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8748 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8749 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8751 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8752 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8753 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8761 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8762 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8764 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8765 & -0.5d0*ekont*(s2d+s12d)
8767 C Cartesian derivatives
8772 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8773 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8774 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8776 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8777 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8779 s2d = scalar2(b1(1,itk),vtemp1d(1))
8781 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8782 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8783 s8d = -(atempd(1,1)+atempd(2,2))*
8784 & scalar2(cc(1,1,itl),vtemp2(1))
8786 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8788 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8789 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8796 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8799 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8803 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8804 & - 0.5d0*(s8d+s12d)
8806 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8815 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8817 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8818 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8819 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8820 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8821 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8823 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8824 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8825 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8829 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8830 cd & 16*eel_turn6_num
8832 if (j.lt.nres-1) then
8839 if (l.lt.nres-1) then
8847 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8848 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8849 cgrad ghalf=0.5d0*ggg1(ll)
8851 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8852 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8853 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8854 & +ekont*derx_turn(ll,2,1)
8855 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8856 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8857 & +ekont*derx_turn(ll,4,1)
8858 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8859 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8860 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8861 cgrad ghalf=0.5d0*ggg2(ll)
8863 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8864 & +ekont*derx_turn(ll,2,2)
8865 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8866 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8867 & +ekont*derx_turn(ll,4,2)
8868 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8869 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8870 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8875 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8880 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8886 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8891 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8895 cd write (2,*) iii,g_corr6_loc(iii)
8897 eello_turn6=ekont*eel_turn6
8898 cd write (2,*) 'ekont',ekont
8899 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8903 C-----------------------------------------------------------------------------
8904 double precision function scalar(u,v)
8905 !DIR$ INLINEALWAYS scalar
8907 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8910 double precision u(3),v(3)
8911 cd double precision sc
8919 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8922 crc-------------------------------------------------
8923 SUBROUTINE MATVEC2(A1,V1,V2)
8924 !DIR$ INLINEALWAYS MATVEC2
8926 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8928 implicit real*8 (a-h,o-z)
8929 include 'DIMENSIONS'
8930 DIMENSION A1(2,2),V1(2),V2(2)
8934 c 3 VI=VI+A1(I,K)*V1(K)
8938 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8939 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8944 C---------------------------------------
8945 SUBROUTINE MATMAT2(A1,A2,A3)
8947 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8949 implicit real*8 (a-h,o-z)
8950 include 'DIMENSIONS'
8951 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8952 c DIMENSION AI3(2,2)
8956 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8962 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8963 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8964 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8965 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8973 c-------------------------------------------------------------------------
8974 double precision function scalar2(u,v)
8975 !DIR$ INLINEALWAYS scalar2
8977 double precision u(2),v(2)
8980 scalar2=u(1)*v(1)+u(2)*v(2)
8984 C-----------------------------------------------------------------------------
8986 subroutine transpose2(a,at)
8987 !DIR$ INLINEALWAYS transpose2
8989 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8992 double precision a(2,2),at(2,2)
8999 c--------------------------------------------------------------------------
9000 subroutine transpose(n,a,at)
9003 double precision a(n,n),at(n,n)
9011 C---------------------------------------------------------------------------
9012 subroutine prodmat3(a1,a2,kk,transp,prod)
9013 !DIR$ INLINEALWAYS prodmat3
9015 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9019 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9021 crc double precision auxmat(2,2),prod_(2,2)
9024 crc call transpose2(kk(1,1),auxmat(1,1))
9025 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9026 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9028 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9029 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9030 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9031 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9032 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9033 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9034 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9035 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9038 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9039 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9041 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9042 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9043 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9044 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9045 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9046 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9047 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9048 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9051 c call transpose2(a2(1,1),a2t(1,1))
9054 crc print *,((prod_(i,j),i=1,2),j=1,2)
9055 crc print *,((prod(i,j),i=1,2),j=1,2)