1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
28 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
29 c & " nfgtasks",nfgtasks
30 if (nfgtasks.gt.1) then
32 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
33 if (fg_rank.eq.0) then
34 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
35 c print *,"Processor",myrank," BROADCAST iorder"
36 C FG master sets up the WEIGHTS_ array which will be broadcast to the
37 C FG slaves as WEIGHTS array.
57 C FG Master broadcasts the WEIGHTS_ array
58 call MPI_Bcast(weights_(1),n_ene,
59 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
61 C FG slaves receive the WEIGHTS array
62 call MPI_Bcast(weights(1),n_ene,
63 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
84 time_Bcast=time_Bcast+MPI_Wtime()-time00
85 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
86 c call chainbuild_cart
88 c print *,'Processor',myrank,' calling etotal ipot=',ipot
89 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
91 c if (modecalc.eq.12.or.modecalc.eq.14) then
92 c call int_from_cart1(.false.)
99 C Compute the side-chain and electrostatic interaction energy
101 goto (101,102,103,104,105,106) ipot
102 C Lennard-Jones potential.
104 cd print '(a)','Exit ELJ'
106 C Lennard-Jones-Kihara potential (shifted).
109 C Berne-Pechukas potential (dilated LJ, angular dependence).
112 C Gay-Berne potential (shifted LJ, angular dependence).
115 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
118 C Soft-sphere potential
119 106 call e_softsphere(evdw)
121 C Calculate electrostatic (H-bonding) energy of the main chain.
125 cmc Sep-06: egb takes care of dynamic ss bonds too
127 c if (dyn_ss) call dyn_set_nss
129 c print *,"Processor",myrank," computed USCSC"
135 time_vec=time_vec+MPI_Wtime()-time01
137 c print *,"Processor",myrank," left VEC_AND_DERIV"
140 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
141 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
142 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
143 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
145 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
146 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
147 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
148 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
150 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
159 c write (iout,*) "Soft-spheer ELEC potential"
160 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
163 c print *,"Processor",myrank," computed UELEC"
165 C Calculate excluded-volume interaction energy between peptide groups
170 call escp(evdw2,evdw2_14)
176 c write (iout,*) "Soft-sphere SCP potential"
177 call escp_soft_sphere(evdw2,evdw2_14)
180 c Calculate the bond-stretching energy
184 C Calculate the disulfide-bridge and other energy and the contributions
185 C from other distance constraints.
186 cd print *,'Calling EHPB'
188 cd print *,'EHPB exitted succesfully.'
190 C Calculate the virtual-bond-angle energy.
192 if (wang.gt.0d0) then
197 c print *,"Processor",myrank," computed UB"
199 C Calculate the SC local energy.
202 c print *,"Processor",myrank," computed USC"
204 C Calculate the virtual-bond torsional energy.
206 cd print *,'nterm=',nterm
208 call etor(etors,edihcnstr)
213 c print *,"Processor",myrank," computed Utor"
215 C 6/23/01 Calculate double-torsional energy
217 if (wtor_d.gt.0) then
222 c print *,"Processor",myrank," computed Utord"
224 C 21/5/07 Calculate local sicdechain correlation energy
226 if (wsccor.gt.0.0d0) then
227 call eback_sc_corr(esccor)
231 c print *,"Processor",myrank," computed Usccorr"
233 C 12/1/95 Multi-body terms
237 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
238 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
239 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
240 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
241 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
248 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
249 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
250 cd write (iout,*) "multibody_hb ecorr",ecorr
252 c print *,"Processor",myrank," computed Ucorr"
254 C If performing constraint dynamics, call the constraint energy
255 C after the equilibration time
256 if(usampl.and.totT.gt.eq_time) then
264 time_enecalc=time_enecalc+MPI_Wtime()-time00
266 c print *,"Processor",myrank," computed Uconstr"
275 energia(2)=evdw2-evdw2_14
292 energia(8)=eello_turn3
293 energia(9)=eello_turn4
300 energia(19)=edihcnstr
302 energia(20)=Uconst+Uconst_back
304 c Here are the energies showed per procesor if the are more processors
305 c per molecule then we sum it up in sum_energy subroutine
306 c print *," Processor",myrank," calls SUM_ENERGY"
307 call sum_energy(energia,.true.)
308 if (dyn_ss) call dyn_set_nss
309 c print *," Processor",myrank," left SUM_ENERGY"
311 time_sumene=time_sumene+MPI_Wtime()-time00
315 c-------------------------------------------------------------------------------
316 subroutine sum_energy(energia,reduce)
317 implicit real*8 (a-h,o-z)
322 cMS$ATTRIBUTES C :: proc_proc
328 include 'COMMON.SETUP'
329 include 'COMMON.IOUNITS'
330 double precision energia(0:n_ene),enebuff(0:n_ene+1)
331 include 'COMMON.FFIELD'
332 include 'COMMON.DERIV'
333 include 'COMMON.INTERACT'
334 include 'COMMON.SBRIDGE'
335 include 'COMMON.CHAIN'
337 include 'COMMON.CONTROL'
338 include 'COMMON.TIME1'
341 if (nfgtasks.gt.1 .and. reduce) then
343 write (iout,*) "energies before REDUCE"
344 call enerprint(energia)
348 enebuff(i)=energia(i)
351 call MPI_Barrier(FG_COMM,IERR)
352 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
354 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
355 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
357 write (iout,*) "energies after REDUCE"
358 call enerprint(energia)
361 time_Reduce=time_Reduce+MPI_Wtime()-time00
363 if (fg_rank.eq.0) then
367 evdw2=energia(2)+energia(18)
383 eello_turn3=energia(8)
384 eello_turn4=energia(9)
391 edihcnstr=energia(19)
396 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
397 & +wang*ebe+wtor*etors+wscloc*escloc
398 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
399 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
400 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
401 & +wbond*estr+Uconst+wsccor*esccor
403 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
404 & +wang*ebe+wtor*etors+wscloc*escloc
405 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
406 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
407 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
408 & +wbond*estr+Uconst+wsccor*esccor
414 if (isnan(etot).ne.0) energia(0)=1.0d+99
416 if (isnan(etot)) energia(0)=1.0d+99
421 idumm=proc_proc(etot,i)
423 call proc_proc(etot,i)
425 if(i.eq.1)energia(0)=1.0d+99
432 c-------------------------------------------------------------------------------
433 subroutine sum_gradient
434 implicit real*8 (a-h,o-z)
439 cMS$ATTRIBUTES C :: proc_proc
444 double precision gradbufc(3,maxres),gradbufx(3,maxres),
445 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
447 include 'COMMON.SETUP'
448 include 'COMMON.IOUNITS'
449 include 'COMMON.FFIELD'
450 include 'COMMON.DERIV'
451 include 'COMMON.INTERACT'
452 include 'COMMON.SBRIDGE'
453 include 'COMMON.CHAIN'
455 include 'COMMON.CONTROL'
456 include 'COMMON.TIME1'
457 include 'COMMON.MAXGRAD'
458 include 'COMMON.SCCOR'
463 write (iout,*) "sum_gradient gvdwc, gvdwx"
465 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
466 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
471 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
472 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
473 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
476 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
477 C in virtual-bond-vector coordinates
480 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
482 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
483 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
485 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
487 c write (iout,'(i5,3f10.5,2x,f10.5)')
488 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
490 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
492 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
493 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
501 gradbufc(j,i)=wsc*gvdwc(j,i)+
502 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
503 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
504 & wel_loc*gel_loc_long(j,i)+
505 & wcorr*gradcorr_long(j,i)+
506 & wcorr5*gradcorr5_long(j,i)+
507 & wcorr6*gradcorr6_long(j,i)+
508 & wturn6*gcorr6_turn_long(j,i)+
515 gradbufc(j,i)=wsc*gvdwc(j,i)+
516 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
517 & welec*gelc_long(j,i)+
519 & wel_loc*gel_loc_long(j,i)+
520 & wcorr*gradcorr_long(j,i)+
521 & wcorr5*gradcorr5_long(j,i)+
522 & wcorr6*gradcorr6_long(j,i)+
523 & wturn6*gcorr6_turn_long(j,i)+
529 if (nfgtasks.gt.1) then
532 write (iout,*) "gradbufc before allreduce"
534 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
540 gradbufc_sum(j,i)=gradbufc(j,i)
543 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
544 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
545 c time_reduce=time_reduce+MPI_Wtime()-time00
547 c write (iout,*) "gradbufc_sum after allreduce"
549 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
554 c time_allreduce=time_allreduce+MPI_Wtime()-time00
562 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
563 write (iout,*) (i," jgrad_start",jgrad_start(i),
564 & " jgrad_end ",jgrad_end(i),
565 & i=igrad_start,igrad_end)
568 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
569 c do not parallelize this part.
571 c do i=igrad_start,igrad_end
572 c do j=jgrad_start(i),jgrad_end(i)
574 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
579 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
583 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
587 write (iout,*) "gradbufc after summing"
589 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
596 write (iout,*) "gradbufc"
598 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
604 gradbufc_sum(j,i)=gradbufc(j,i)
609 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
613 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
618 c gradbufc(k,i)=0.0d0
622 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
627 write (iout,*) "gradbufc after summing"
629 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
637 gradbufc(k,nres)=0.0d0
642 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
643 & wel_loc*gel_loc(j,i)+
644 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
645 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
646 & wel_loc*gel_loc_long(j,i)+
647 & wcorr*gradcorr_long(j,i)+
648 & wcorr5*gradcorr5_long(j,i)+
649 & wcorr6*gradcorr6_long(j,i)+
650 & wturn6*gcorr6_turn_long(j,i))+
652 & wcorr*gradcorr(j,i)+
653 & wturn3*gcorr3_turn(j,i)+
654 & wturn4*gcorr4_turn(j,i)+
655 & wcorr5*gradcorr5(j,i)+
656 & wcorr6*gradcorr6(j,i)+
657 & wturn6*gcorr6_turn(j,i)+
658 & wsccor*gsccorc(j,i)
659 & +wscloc*gscloc(j,i)
661 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
662 & wel_loc*gel_loc(j,i)+
663 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
664 & welec*gelc_long(j,i)
665 & wel_loc*gel_loc_long(j,i)+
666 & wcorr*gcorr_long(j,i)+
667 & wcorr5*gradcorr5_long(j,i)+
668 & wcorr6*gradcorr6_long(j,i)+
669 & wturn6*gcorr6_turn_long(j,i))+
671 & wcorr*gradcorr(j,i)+
672 & wturn3*gcorr3_turn(j,i)+
673 & wturn4*gcorr4_turn(j,i)+
674 & wcorr5*gradcorr5(j,i)+
675 & wcorr6*gradcorr6(j,i)+
676 & wturn6*gcorr6_turn(j,i)+
677 & wsccor*gsccorc(j,i)
678 & +wscloc*gscloc(j,i)
680 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
682 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
683 & wsccor*gsccorx(j,i)
684 & +wscloc*gsclocx(j,i)
688 write (iout,*) "gloc before adding corr"
690 write (iout,*) i,gloc(i,icg)
694 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
695 & +wcorr5*g_corr5_loc(i)
696 & +wcorr6*g_corr6_loc(i)
697 & +wturn4*gel_loc_turn4(i)
698 & +wturn3*gel_loc_turn3(i)
699 & +wturn6*gel_loc_turn6(i)
700 & +wel_loc*gel_loc_loc(i)
703 write (iout,*) "gloc after adding corr"
705 write (iout,*) i,gloc(i,icg)
709 if (nfgtasks.gt.1) then
712 gradbufc(j,i)=gradc(j,i,icg)
713 gradbufx(j,i)=gradx(j,i,icg)
717 glocbuf(i)=gloc(i,icg)
721 write (iout,*) "gloc_sc before reduce"
724 write (iout,*) i,j,gloc_sc(j,i,icg)
731 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
735 call MPI_Barrier(FG_COMM,IERR)
736 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
738 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
739 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
740 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
741 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
742 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
743 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
744 time_reduce=time_reduce+MPI_Wtime()-time00
745 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
746 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
747 time_reduce=time_reduce+MPI_Wtime()-time00
750 write (iout,*) "gloc_sc after reduce"
753 write (iout,*) i,j,gloc_sc(j,i,icg)
759 write (iout,*) "gloc after reduce"
761 write (iout,*) i,gloc(i,icg)
766 if (gnorm_check) then
768 c Compute the maximum elements of the gradient
778 gcorr3_turn_max=0.0d0
779 gcorr4_turn_max=0.0d0
782 gcorr6_turn_max=0.0d0
792 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
793 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
794 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
795 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
796 & gvdwc_scp_max=gvdwc_scp_norm
797 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
798 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
799 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
800 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
801 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
802 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
803 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
804 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
805 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
806 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
807 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
808 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
809 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
811 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
812 & gcorr3_turn_max=gcorr3_turn_norm
813 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
815 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
816 & gcorr4_turn_max=gcorr4_turn_norm
817 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
818 if (gradcorr5_norm.gt.gradcorr5_max)
819 & gradcorr5_max=gradcorr5_norm
820 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
821 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
822 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
824 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
825 & gcorr6_turn_max=gcorr6_turn_norm
826 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
827 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
828 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
829 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
830 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
831 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
832 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
833 if (gradx_scp_norm.gt.gradx_scp_max)
834 & gradx_scp_max=gradx_scp_norm
835 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
836 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
837 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
838 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
839 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
840 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
841 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
842 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
846 open(istat,file=statname,position="append")
848 open(istat,file=statname,access="append")
850 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
851 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
852 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
853 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
854 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
855 & gsccorx_max,gsclocx_max
857 if (gvdwc_max.gt.1.0d4) then
858 write (iout,*) "gvdwc gvdwx gradb gradbx"
860 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
861 & gradb(j,i),gradbx(j,i),j=1,3)
863 call pdbout(0.0d0,'cipiszcze',iout)
869 write (iout,*) "gradc gradx gloc"
871 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
872 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
876 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
880 c-------------------------------------------------------------------------------
881 subroutine rescale_weights(t_bath)
882 implicit real*8 (a-h,o-z)
884 include 'COMMON.IOUNITS'
885 include 'COMMON.FFIELD'
886 include 'COMMON.SBRIDGE'
887 double precision kfac /2.4d0/
888 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
890 c facT=2*temp0/(t_bath+temp0)
891 if (rescale_mode.eq.0) then
897 else if (rescale_mode.eq.1) then
898 facT=kfac/(kfac-1.0d0+t_bath/temp0)
899 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
900 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
901 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
902 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
903 else if (rescale_mode.eq.2) then
909 facT=licznik/dlog(dexp(x)+dexp(-x))
910 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
911 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
912 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
913 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
915 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
916 write (*,*) "Wrong RESCALE_MODE",rescale_mode
918 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
922 welec=weights(3)*fact
923 wcorr=weights(4)*fact3
924 wcorr5=weights(5)*fact4
925 wcorr6=weights(6)*fact5
926 wel_loc=weights(7)*fact2
927 wturn3=weights(8)*fact2
928 wturn4=weights(9)*fact3
929 wturn6=weights(10)*fact5
930 wtor=weights(13)*fact
931 wtor_d=weights(14)*fact2
932 wsccor=weights(21)*fact
936 C------------------------------------------------------------------------
937 subroutine enerprint(energia)
938 implicit real*8 (a-h,o-z)
940 include 'COMMON.IOUNITS'
941 include 'COMMON.FFIELD'
942 include 'COMMON.SBRIDGE'
944 double precision energia(0:n_ene)
949 evdw2=energia(2)+energia(18)
961 eello_turn3=energia(8)
962 eello_turn4=energia(9)
963 eello_turn6=energia(10)
969 edihcnstr=energia(19)
974 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
975 & estr,wbond,ebe,wang,
976 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
978 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
979 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
982 10 format (/'Virtual-chain energies:'//
983 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
984 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
985 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
986 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
987 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
988 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
989 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
990 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
991 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
992 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
993 & ' (SS bridges & dist. cnstr.)'/
994 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
995 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
996 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
997 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
998 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
999 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1000 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1001 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1002 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1003 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1004 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1005 & 'ETOT= ',1pE16.6,' (total)')
1007 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1008 & estr,wbond,ebe,wang,
1009 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1011 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1012 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1013 & ebr*nss,Uconst,etot
1014 10 format (/'Virtual-chain energies:'//
1015 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1016 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1017 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1018 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1019 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1020 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1021 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1022 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1023 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1024 & ' (SS bridges & dist. cnstr.)'/
1025 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1026 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1027 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1028 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1029 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1030 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1031 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1032 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1033 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1034 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1035 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1036 & 'ETOT= ',1pE16.6,' (total)')
1040 C-----------------------------------------------------------------------
1041 subroutine elj(evdw)
1043 C This subroutine calculates the interaction energy of nonbonded side chains
1044 C assuming the LJ potential of interaction.
1046 implicit real*8 (a-h,o-z)
1047 include 'DIMENSIONS'
1048 parameter (accur=1.0d-10)
1049 include 'COMMON.GEO'
1050 include 'COMMON.VAR'
1051 include 'COMMON.LOCAL'
1052 include 'COMMON.CHAIN'
1053 include 'COMMON.DERIV'
1054 include 'COMMON.INTERACT'
1055 include 'COMMON.TORSION'
1056 include 'COMMON.SBRIDGE'
1057 include 'COMMON.NAMES'
1058 include 'COMMON.IOUNITS'
1059 include 'COMMON.CONTACTS'
1061 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1063 do i=iatsc_s,iatsc_e
1064 itypi=iabs(itype(i))
1065 if (itypi.eq.ntyp1) cycle
1066 itypi1=iabs(itype(i+1))
1073 C Calculate SC interaction energy.
1075 do iint=1,nint_gr(i)
1076 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1077 cd & 'iend=',iend(i,iint)
1078 do j=istart(i,iint),iend(i,iint)
1079 itypj=iabs(itype(j))
1080 if (itypj.eq.ntyp1) cycle
1084 C Change 12/1/95 to calculate four-body interactions
1085 rij=xj*xj+yj*yj+zj*zj
1087 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1088 eps0ij=eps(itypi,itypj)
1090 e1=fac*fac*aa(itypi,itypj)
1091 e2=fac*bb(itypi,itypj)
1093 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1094 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1095 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1096 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1097 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1098 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1101 C Calculate the components of the gradient in DC and X
1103 fac=-rrij*(e1+evdwij)
1108 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1109 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1110 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1111 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1115 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1119 C 12/1/95, revised on 5/20/97
1121 C Calculate the contact function. The ith column of the array JCONT will
1122 C contain the numbers of atoms that make contacts with the atom I (of numbers
1123 C greater than I). The arrays FACONT and GACONT will contain the values of
1124 C the contact function and its derivative.
1126 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1127 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1128 C Uncomment next line, if the correlation interactions are contact function only
1129 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1131 sigij=sigma(itypi,itypj)
1132 r0ij=rs0(itypi,itypj)
1134 C Check whether the SC's are not too far to make a contact.
1137 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1138 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1140 if (fcont.gt.0.0D0) then
1141 C If the SC-SC distance if close to sigma, apply spline.
1142 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1143 cAdam & fcont1,fprimcont1)
1144 cAdam fcont1=1.0d0-fcont1
1145 cAdam if (fcont1.gt.0.0d0) then
1146 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1147 cAdam fcont=fcont*fcont1
1149 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1150 cga eps0ij=1.0d0/dsqrt(eps0ij)
1152 cga gg(k)=gg(k)*eps0ij
1154 cga eps0ij=-evdwij*eps0ij
1155 C Uncomment for AL's type of SC correlation interactions.
1156 cadam eps0ij=-evdwij
1157 num_conti=num_conti+1
1158 jcont(num_conti,i)=j
1159 facont(num_conti,i)=fcont*eps0ij
1160 fprimcont=eps0ij*fprimcont/rij
1162 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1163 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1164 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1165 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1166 gacont(1,num_conti,i)=-fprimcont*xj
1167 gacont(2,num_conti,i)=-fprimcont*yj
1168 gacont(3,num_conti,i)=-fprimcont*zj
1169 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1170 cd write (iout,'(2i3,3f10.5)')
1171 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1177 num_cont(i)=num_conti
1181 gvdwc(j,i)=expon*gvdwc(j,i)
1182 gvdwx(j,i)=expon*gvdwx(j,i)
1185 C******************************************************************************
1189 C To save time, the factor of EXPON has been extracted from ALL components
1190 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1193 C******************************************************************************
1196 C-----------------------------------------------------------------------------
1197 subroutine eljk(evdw)
1199 C This subroutine calculates the interaction energy of nonbonded side chains
1200 C assuming the LJK potential of interaction.
1202 implicit real*8 (a-h,o-z)
1203 include 'DIMENSIONS'
1204 include 'COMMON.GEO'
1205 include 'COMMON.VAR'
1206 include 'COMMON.LOCAL'
1207 include 'COMMON.CHAIN'
1208 include 'COMMON.DERIV'
1209 include 'COMMON.INTERACT'
1210 include 'COMMON.IOUNITS'
1211 include 'COMMON.NAMES'
1214 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1216 do i=iatsc_s,iatsc_e
1217 itypi=iabs(itype(i))
1218 if (itypi.eq.ntyp1) cycle
1219 itypi1=iabs(itype(i+1))
1224 C Calculate SC interaction energy.
1226 do iint=1,nint_gr(i)
1227 do j=istart(i,iint),iend(i,iint)
1228 itypj=iabs(itype(j))
1229 if (itypj.eq.ntyp1) cycle
1233 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1234 fac_augm=rrij**expon
1235 e_augm=augm(itypi,itypj)*fac_augm
1236 r_inv_ij=dsqrt(rrij)
1238 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1239 fac=r_shift_inv**expon
1240 e1=fac*fac*aa(itypi,itypj)
1241 e2=fac*bb(itypi,itypj)
1243 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1244 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1245 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1246 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1247 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1248 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1249 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1252 C Calculate the components of the gradient in DC and X
1254 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1259 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1260 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1261 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1262 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1266 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1274 gvdwc(j,i)=expon*gvdwc(j,i)
1275 gvdwx(j,i)=expon*gvdwx(j,i)
1280 C-----------------------------------------------------------------------------
1281 subroutine ebp(evdw)
1283 C This subroutine calculates the interaction energy of nonbonded side chains
1284 C assuming the Berne-Pechukas potential of interaction.
1286 implicit real*8 (a-h,o-z)
1287 include 'DIMENSIONS'
1288 include 'COMMON.GEO'
1289 include 'COMMON.VAR'
1290 include 'COMMON.LOCAL'
1291 include 'COMMON.CHAIN'
1292 include 'COMMON.DERIV'
1293 include 'COMMON.NAMES'
1294 include 'COMMON.INTERACT'
1295 include 'COMMON.IOUNITS'
1296 include 'COMMON.CALC'
1297 common /srutu/ icall
1298 c double precision rrsave(maxdim)
1301 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1303 c if (icall.eq.0) then
1309 do i=iatsc_s,iatsc_e
1310 itypi=iabs(itype(i))
1311 if (itypi.eq.ntyp1) cycle
1312 itypi1=iabs(itype(i+1))
1316 dxi=dc_norm(1,nres+i)
1317 dyi=dc_norm(2,nres+i)
1318 dzi=dc_norm(3,nres+i)
1319 c dsci_inv=dsc_inv(itypi)
1320 dsci_inv=vbld_inv(i+nres)
1322 C Calculate SC interaction energy.
1324 do iint=1,nint_gr(i)
1325 do j=istart(i,iint),iend(i,iint)
1327 itypj=iabs(itype(j))
1328 if (itypj.eq.ntyp1) cycle
1329 c dscj_inv=dsc_inv(itypj)
1330 dscj_inv=vbld_inv(j+nres)
1331 chi1=chi(itypi,itypj)
1332 chi2=chi(itypj,itypi)
1339 alf12=0.5D0*(alf1+alf2)
1340 C For diagnostics only!!!
1353 dxj=dc_norm(1,nres+j)
1354 dyj=dc_norm(2,nres+j)
1355 dzj=dc_norm(3,nres+j)
1356 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1357 cd if (icall.eq.0) then
1363 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1365 C Calculate whole angle-dependent part of epsilon and contributions
1366 C to its derivatives
1367 fac=(rrij*sigsq)**expon2
1368 e1=fac*fac*aa(itypi,itypj)
1369 e2=fac*bb(itypi,itypj)
1370 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1371 eps2der=evdwij*eps3rt
1372 eps3der=evdwij*eps2rt
1373 evdwij=evdwij*eps2rt*eps3rt
1376 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1377 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1378 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1379 cd & restyp(itypi),i,restyp(itypj),j,
1380 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1381 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1382 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1385 C Calculate gradient components.
1386 e1=e1*eps1*eps2rt**2*eps3rt**2
1387 fac=-expon*(e1+evdwij)
1390 C Calculate radial part of the gradient
1394 C Calculate the angular part of the gradient and sum add the contributions
1395 C to the appropriate components of the Cartesian gradient.
1403 C-----------------------------------------------------------------------------
1404 subroutine egb(evdw)
1406 C This subroutine calculates the interaction energy of nonbonded side chains
1407 C assuming the Gay-Berne potential of interaction.
1409 implicit real*8 (a-h,o-z)
1410 include 'DIMENSIONS'
1411 include 'COMMON.GEO'
1412 include 'COMMON.VAR'
1413 include 'COMMON.LOCAL'
1414 include 'COMMON.CHAIN'
1415 include 'COMMON.DERIV'
1416 include 'COMMON.NAMES'
1417 include 'COMMON.INTERACT'
1418 include 'COMMON.IOUNITS'
1419 include 'COMMON.CALC'
1420 include 'COMMON.CONTROL'
1421 include 'COMMON.SBRIDGE'
1424 c write(iout,*) "Jestem w egb(evdw)"
1427 ccccc energy_dec=.false.
1428 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1431 c if (icall.eq.0) lprn=.false.
1433 do i=iatsc_s,iatsc_e
1434 itypi=iabs(itype(i))
1435 if (itypi.eq.ntyp1) cycle
1436 itypi1=iabs(itype(i+1))
1440 dxi=dc_norm(1,nres+i)
1441 dyi=dc_norm(2,nres+i)
1442 dzi=dc_norm(3,nres+i)
1443 c dsci_inv=dsc_inv(itypi)
1444 dsci_inv=vbld_inv(i+nres)
1445 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1446 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1448 C Calculate SC interaction energy.
1450 do iint=1,nint_gr(i)
1451 do j=istart(i,iint),iend(i,iint)
1452 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1454 c write(iout,*) "PRZED ZWYKLE", evdwij
1455 call dyn_ssbond_ene(i,j,evdwij)
1456 c write(iout,*) "PO ZWYKLE", evdwij
1459 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1460 & 'evdw',i,j,evdwij,' ss'
1461 C triple bond artifac removal
1462 do k=j+1,iend(i,iint)
1463 C search over all next residues
1464 if (dyn_ss_mask(k)) then
1465 C check if they are cysteins
1466 C write(iout,*) 'k=',k
1468 c write(iout,*) "PRZED TRI", evdwij
1469 evdwij_przed_tri=evdwij
1470 call triple_ssbond_ene(i,j,k,evdwij)
1471 c if(evdwij_przed_tri.ne.evdwij) then
1472 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1475 c write(iout,*) "PO TRI", evdwij
1476 C call the energy function that removes the artifical triple disulfide
1477 C bond the soubroutine is located in ssMD.F
1479 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1480 & 'evdw',i,j,evdwij,'tss'
1481 endif!dyn_ss_mask(k)
1485 itypj=iabs(itype(j))
1486 if (itypj.eq.ntyp1) cycle
1487 c dscj_inv=dsc_inv(itypj)
1488 dscj_inv=vbld_inv(j+nres)
1489 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1490 c & 1.0d0/vbld(j+nres)
1491 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1492 sig0ij=sigma(itypi,itypj)
1493 chi1=chi(itypi,itypj)
1494 chi2=chi(itypj,itypi)
1501 alf12=0.5D0*(alf1+alf2)
1502 C For diagnostics only!!!
1515 dxj=dc_norm(1,nres+j)
1516 dyj=dc_norm(2,nres+j)
1517 dzj=dc_norm(3,nres+j)
1518 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1519 c write (iout,*) "j",j," dc_norm",
1520 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1521 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1523 C Calculate angle-dependent terms of energy and contributions to their
1527 sig=sig0ij*dsqrt(sigsq)
1528 rij_shift=1.0D0/rij-sig+sig0ij
1529 c for diagnostics; uncomment
1530 c rij_shift=1.2*sig0ij
1531 C I hate to put IF's in the loops, but here don't have another choice!!!!
1532 if (rij_shift.le.0.0D0) then
1534 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1535 cd & restyp(itypi),i,restyp(itypj),j,
1536 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1540 c---------------------------------------------------------------
1541 rij_shift=1.0D0/rij_shift
1542 fac=rij_shift**expon
1543 e1=fac*fac*aa(itypi,itypj)
1544 e2=fac*bb(itypi,itypj)
1545 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1546 eps2der=evdwij*eps3rt
1547 eps3der=evdwij*eps2rt
1548 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1549 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1550 evdwij=evdwij*eps2rt*eps3rt
1553 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1554 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1555 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1556 & restyp(itypi),i,restyp(itypj),j,
1557 & epsi,sigm,chi1,chi2,chip1,chip2,
1558 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1559 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1563 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1566 C Calculate gradient components.
1567 e1=e1*eps1*eps2rt**2*eps3rt**2
1568 fac=-expon*(e1+evdwij)*rij_shift
1572 C Calculate the radial part of the gradient
1576 C Calculate angular part of the gradient.
1582 c write (iout,*) "Number of loop steps in EGB:",ind
1583 cccc energy_dec=.false.
1586 C-----------------------------------------------------------------------------
1587 subroutine egbv(evdw)
1589 C This subroutine calculates the interaction energy of nonbonded side chains
1590 C assuming the Gay-Berne-Vorobjev potential of interaction.
1592 implicit real*8 (a-h,o-z)
1593 include 'DIMENSIONS'
1594 include 'COMMON.GEO'
1595 include 'COMMON.VAR'
1596 include 'COMMON.LOCAL'
1597 include 'COMMON.CHAIN'
1598 include 'COMMON.DERIV'
1599 include 'COMMON.NAMES'
1600 include 'COMMON.INTERACT'
1601 include 'COMMON.IOUNITS'
1602 include 'COMMON.CALC'
1603 common /srutu/ icall
1606 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1609 c if (icall.eq.0) lprn=.true.
1611 do i=iatsc_s,iatsc_e
1612 itypi=iabs(itype(i))
1613 if (itypi.eq.ntyp1) cycle
1614 itypi1=iabs(itype(i+1))
1618 dxi=dc_norm(1,nres+i)
1619 dyi=dc_norm(2,nres+i)
1620 dzi=dc_norm(3,nres+i)
1621 c dsci_inv=dsc_inv(itypi)
1622 dsci_inv=vbld_inv(i+nres)
1624 C Calculate SC interaction energy.
1626 do iint=1,nint_gr(i)
1627 do j=istart(i,iint),iend(i,iint)
1629 itypj=iabs(itype(j))
1630 if (itypj.eq.ntyp1) cycle
1631 c dscj_inv=dsc_inv(itypj)
1632 dscj_inv=vbld_inv(j+nres)
1633 sig0ij=sigma(itypi,itypj)
1634 r0ij=r0(itypi,itypj)
1635 chi1=chi(itypi,itypj)
1636 chi2=chi(itypj,itypi)
1643 alf12=0.5D0*(alf1+alf2)
1644 C For diagnostics only!!!
1657 dxj=dc_norm(1,nres+j)
1658 dyj=dc_norm(2,nres+j)
1659 dzj=dc_norm(3,nres+j)
1660 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1662 C Calculate angle-dependent terms of energy and contributions to their
1666 sig=sig0ij*dsqrt(sigsq)
1667 rij_shift=1.0D0/rij-sig+r0ij
1668 C I hate to put IF's in the loops, but here don't have another choice!!!!
1669 if (rij_shift.le.0.0D0) then
1674 c---------------------------------------------------------------
1675 rij_shift=1.0D0/rij_shift
1676 fac=rij_shift**expon
1677 e1=fac*fac*aa(itypi,itypj)
1678 e2=fac*bb(itypi,itypj)
1679 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1680 eps2der=evdwij*eps3rt
1681 eps3der=evdwij*eps2rt
1682 fac_augm=rrij**expon
1683 e_augm=augm(itypi,itypj)*fac_augm
1684 evdwij=evdwij*eps2rt*eps3rt
1685 evdw=evdw+evdwij+e_augm
1687 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1688 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1689 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1690 & restyp(itypi),i,restyp(itypj),j,
1691 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1692 & chi1,chi2,chip1,chip2,
1693 & eps1,eps2rt**2,eps3rt**2,
1694 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1697 C Calculate gradient components.
1698 e1=e1*eps1*eps2rt**2*eps3rt**2
1699 fac=-expon*(e1+evdwij)*rij_shift
1701 fac=rij*fac-2*expon*rrij*e_augm
1702 C Calculate the radial part of the gradient
1706 C Calculate angular part of the gradient.
1712 C-----------------------------------------------------------------------------
1713 subroutine sc_angular
1714 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1715 C om12. Called by ebp, egb, and egbv.
1717 include 'COMMON.CALC'
1718 include 'COMMON.IOUNITS'
1722 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1723 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1724 om12=dxi*dxj+dyi*dyj+dzi*dzj
1726 C Calculate eps1(om12) and its derivative in om12
1727 faceps1=1.0D0-om12*chiom12
1728 faceps1_inv=1.0D0/faceps1
1729 eps1=dsqrt(faceps1_inv)
1730 C Following variable is eps1*deps1/dom12
1731 eps1_om12=faceps1_inv*chiom12
1736 c write (iout,*) "om12",om12," eps1",eps1
1737 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1742 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1743 sigsq=1.0D0-facsig*faceps1_inv
1744 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1745 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1746 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1752 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1753 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1755 C Calculate eps2 and its derivatives in om1, om2, and om12.
1758 chipom12=chip12*om12
1759 facp=1.0D0-om12*chipom12
1761 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1762 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1763 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1764 C Following variable is the square root of eps2
1765 eps2rt=1.0D0-facp1*facp_inv
1766 C Following three variables are the derivatives of the square root of eps
1767 C in om1, om2, and om12.
1768 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1769 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1770 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1771 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1772 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1773 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1774 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1775 c & " eps2rt_om12",eps2rt_om12
1776 C Calculate whole angle-dependent part of epsilon and contributions
1777 C to its derivatives
1780 C----------------------------------------------------------------------------
1782 implicit real*8 (a-h,o-z)
1783 include 'DIMENSIONS'
1784 include 'COMMON.CHAIN'
1785 include 'COMMON.DERIV'
1786 include 'COMMON.CALC'
1787 include 'COMMON.IOUNITS'
1788 double precision dcosom1(3),dcosom2(3)
1789 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1790 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1791 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1792 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1796 c eom12=evdwij*eps1_om12
1798 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1799 c & " sigder",sigder
1800 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1801 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1803 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1804 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1807 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1809 c write (iout,*) "gg",(gg(k),k=1,3)
1811 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1812 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1813 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1814 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1815 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1816 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1817 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1818 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1819 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1820 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1823 C Calculate the components of the gradient in DC and X
1827 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1831 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1832 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1836 C-----------------------------------------------------------------------
1837 subroutine e_softsphere(evdw)
1839 C This subroutine calculates the interaction energy of nonbonded side chains
1840 C assuming the LJ potential of interaction.
1842 implicit real*8 (a-h,o-z)
1843 include 'DIMENSIONS'
1844 parameter (accur=1.0d-10)
1845 include 'COMMON.GEO'
1846 include 'COMMON.VAR'
1847 include 'COMMON.LOCAL'
1848 include 'COMMON.CHAIN'
1849 include 'COMMON.DERIV'
1850 include 'COMMON.INTERACT'
1851 include 'COMMON.TORSION'
1852 include 'COMMON.SBRIDGE'
1853 include 'COMMON.NAMES'
1854 include 'COMMON.IOUNITS'
1855 include 'COMMON.CONTACTS'
1857 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1859 do i=iatsc_s,iatsc_e
1860 itypi=iabs(itype(i))
1861 if (itypi.eq.ntyp1) cycle
1862 itypi1=iabs(itype(i+1))
1867 C Calculate SC interaction energy.
1869 do iint=1,nint_gr(i)
1870 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1871 cd & 'iend=',iend(i,iint)
1872 do j=istart(i,iint),iend(i,iint)
1873 itypj=iabs(itype(j))
1874 if (itypj.eq.ntyp1) cycle
1878 rij=xj*xj+yj*yj+zj*zj
1879 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1880 r0ij=r0(itypi,itypj)
1882 c print *,i,j,r0ij,dsqrt(rij)
1883 if (rij.lt.r0ijsq) then
1884 evdwij=0.25d0*(rij-r0ijsq)**2
1892 C Calculate the components of the gradient in DC and X
1898 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1899 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1900 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1901 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1905 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1913 C--------------------------------------------------------------------------
1914 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1917 C Soft-sphere potential of p-p interaction
1919 implicit real*8 (a-h,o-z)
1920 include 'DIMENSIONS'
1921 include 'COMMON.CONTROL'
1922 include 'COMMON.IOUNITS'
1923 include 'COMMON.GEO'
1924 include 'COMMON.VAR'
1925 include 'COMMON.LOCAL'
1926 include 'COMMON.CHAIN'
1927 include 'COMMON.DERIV'
1928 include 'COMMON.INTERACT'
1929 include 'COMMON.CONTACTS'
1930 include 'COMMON.TORSION'
1931 include 'COMMON.VECTORS'
1932 include 'COMMON.FFIELD'
1934 cd write(iout,*) 'In EELEC_soft_sphere'
1941 do i=iatel_s,iatel_e
1942 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1946 xmedi=c(1,i)+0.5d0*dxi
1947 ymedi=c(2,i)+0.5d0*dyi
1948 zmedi=c(3,i)+0.5d0*dzi
1950 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1951 do j=ielstart(i),ielend(i)
1952 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1956 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1957 r0ij=rpp(iteli,itelj)
1962 xj=c(1,j)+0.5D0*dxj-xmedi
1963 yj=c(2,j)+0.5D0*dyj-ymedi
1964 zj=c(3,j)+0.5D0*dzj-zmedi
1965 rij=xj*xj+yj*yj+zj*zj
1966 if (rij.lt.r0ijsq) then
1967 evdw1ij=0.25d0*(rij-r0ijsq)**2
1975 C Calculate contributions to the Cartesian gradient.
1981 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1982 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1985 * Loop over residues i+1 thru j-1.
1989 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
1994 cgrad do i=nnt,nct-1
1996 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1998 cgrad do j=i+1,nct-1
2000 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2006 c------------------------------------------------------------------------------
2007 subroutine vec_and_deriv
2008 implicit real*8 (a-h,o-z)
2009 include 'DIMENSIONS'
2013 include 'COMMON.IOUNITS'
2014 include 'COMMON.GEO'
2015 include 'COMMON.VAR'
2016 include 'COMMON.LOCAL'
2017 include 'COMMON.CHAIN'
2018 include 'COMMON.VECTORS'
2019 include 'COMMON.SETUP'
2020 include 'COMMON.TIME1'
2021 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2022 C Compute the local reference systems. For reference system (i), the
2023 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2024 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2026 do i=ivec_start,ivec_end
2030 if (i.eq.nres-1) then
2031 C Case of the last full residue
2032 C Compute the Z-axis
2033 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2034 costh=dcos(pi-theta(nres))
2035 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2039 C Compute the derivatives of uz
2041 uzder(2,1,1)=-dc_norm(3,i-1)
2042 uzder(3,1,1)= dc_norm(2,i-1)
2043 uzder(1,2,1)= dc_norm(3,i-1)
2045 uzder(3,2,1)=-dc_norm(1,i-1)
2046 uzder(1,3,1)=-dc_norm(2,i-1)
2047 uzder(2,3,1)= dc_norm(1,i-1)
2050 uzder(2,1,2)= dc_norm(3,i)
2051 uzder(3,1,2)=-dc_norm(2,i)
2052 uzder(1,2,2)=-dc_norm(3,i)
2054 uzder(3,2,2)= dc_norm(1,i)
2055 uzder(1,3,2)= dc_norm(2,i)
2056 uzder(2,3,2)=-dc_norm(1,i)
2058 C Compute the Y-axis
2061 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2063 C Compute the derivatives of uy
2066 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2067 & -dc_norm(k,i)*dc_norm(j,i-1)
2068 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2070 uyder(j,j,1)=uyder(j,j,1)-costh
2071 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2076 uygrad(l,k,j,i)=uyder(l,k,j)
2077 uzgrad(l,k,j,i)=uzder(l,k,j)
2081 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2082 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2083 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2084 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2087 C Compute the Z-axis
2088 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2089 costh=dcos(pi-theta(i+2))
2090 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2094 C Compute the derivatives of uz
2096 uzder(2,1,1)=-dc_norm(3,i+1)
2097 uzder(3,1,1)= dc_norm(2,i+1)
2098 uzder(1,2,1)= dc_norm(3,i+1)
2100 uzder(3,2,1)=-dc_norm(1,i+1)
2101 uzder(1,3,1)=-dc_norm(2,i+1)
2102 uzder(2,3,1)= dc_norm(1,i+1)
2105 uzder(2,1,2)= dc_norm(3,i)
2106 uzder(3,1,2)=-dc_norm(2,i)
2107 uzder(1,2,2)=-dc_norm(3,i)
2109 uzder(3,2,2)= dc_norm(1,i)
2110 uzder(1,3,2)= dc_norm(2,i)
2111 uzder(2,3,2)=-dc_norm(1,i)
2113 C Compute the Y-axis
2116 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2118 C Compute the derivatives of uy
2121 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2122 & -dc_norm(k,i)*dc_norm(j,i+1)
2123 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2125 uyder(j,j,1)=uyder(j,j,1)-costh
2126 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2131 uygrad(l,k,j,i)=uyder(l,k,j)
2132 uzgrad(l,k,j,i)=uzder(l,k,j)
2136 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2137 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2138 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2139 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2143 vbld_inv_temp(1)=vbld_inv(i+1)
2144 if (i.lt.nres-1) then
2145 vbld_inv_temp(2)=vbld_inv(i+2)
2147 vbld_inv_temp(2)=vbld_inv(i)
2152 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2153 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2158 #if defined(PARVEC) && defined(MPI)
2159 if (nfgtasks1.gt.1) then
2161 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2162 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2163 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2164 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2165 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2167 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2168 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2170 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2171 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2172 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2173 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2174 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2175 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2176 time_gather=time_gather+MPI_Wtime()-time00
2178 c if (fg_rank.eq.0) then
2179 c write (iout,*) "Arrays UY and UZ"
2181 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2188 C-----------------------------------------------------------------------------
2189 subroutine check_vecgrad
2190 implicit real*8 (a-h,o-z)
2191 include 'DIMENSIONS'
2192 include 'COMMON.IOUNITS'
2193 include 'COMMON.GEO'
2194 include 'COMMON.VAR'
2195 include 'COMMON.LOCAL'
2196 include 'COMMON.CHAIN'
2197 include 'COMMON.VECTORS'
2198 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2199 dimension uyt(3,maxres),uzt(3,maxres)
2200 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2201 double precision delta /1.0d-7/
2204 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2205 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2206 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2207 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2208 cd & (dc_norm(if90,i),if90=1,3)
2209 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2210 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2211 cd write(iout,'(a)')
2217 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2218 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2231 cd write (iout,*) 'i=',i
2233 erij(k)=dc_norm(k,i)
2237 dc_norm(k,i)=erij(k)
2239 dc_norm(j,i)=dc_norm(j,i)+delta
2240 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2242 c dc_norm(k,i)=dc_norm(k,i)/fac
2244 c write (iout,*) (dc_norm(k,i),k=1,3)
2245 c write (iout,*) (erij(k),k=1,3)
2248 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2249 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2250 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2251 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2253 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2254 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2255 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2258 dc_norm(k,i)=erij(k)
2261 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2262 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2263 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2264 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2265 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2266 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2267 cd write (iout,'(a)')
2272 C--------------------------------------------------------------------------
2273 subroutine set_matrices
2274 implicit real*8 (a-h,o-z)
2275 include 'DIMENSIONS'
2278 include "COMMON.SETUP"
2280 integer status(MPI_STATUS_SIZE)
2282 include 'COMMON.IOUNITS'
2283 include 'COMMON.GEO'
2284 include 'COMMON.VAR'
2285 include 'COMMON.LOCAL'
2286 include 'COMMON.CHAIN'
2287 include 'COMMON.DERIV'
2288 include 'COMMON.INTERACT'
2289 include 'COMMON.CONTACTS'
2290 include 'COMMON.TORSION'
2291 include 'COMMON.VECTORS'
2292 include 'COMMON.FFIELD'
2293 double precision auxvec(2),auxmat(2,2)
2295 C Compute the virtual-bond-torsional-angle dependent quantities needed
2296 C to calculate the el-loc multibody terms of various order.
2299 do i=ivec_start+2,ivec_end+2
2303 if (i .lt. nres+1) then
2340 if (i .gt. 3 .and. i .lt. nres+1) then
2341 obrot_der(1,i-2)=-sin1
2342 obrot_der(2,i-2)= cos1
2343 Ugder(1,1,i-2)= sin1
2344 Ugder(1,2,i-2)=-cos1
2345 Ugder(2,1,i-2)=-cos1
2346 Ugder(2,2,i-2)=-sin1
2349 obrot2_der(1,i-2)=-dwasin2
2350 obrot2_der(2,i-2)= dwacos2
2351 Ug2der(1,1,i-2)= dwasin2
2352 Ug2der(1,2,i-2)=-dwacos2
2353 Ug2der(2,1,i-2)=-dwacos2
2354 Ug2der(2,2,i-2)=-dwasin2
2356 obrot_der(1,i-2)=0.0d0
2357 obrot_der(2,i-2)=0.0d0
2358 Ugder(1,1,i-2)=0.0d0
2359 Ugder(1,2,i-2)=0.0d0
2360 Ugder(2,1,i-2)=0.0d0
2361 Ugder(2,2,i-2)=0.0d0
2362 obrot2_der(1,i-2)=0.0d0
2363 obrot2_der(2,i-2)=0.0d0
2364 Ug2der(1,1,i-2)=0.0d0
2365 Ug2der(1,2,i-2)=0.0d0
2366 Ug2der(2,1,i-2)=0.0d0
2367 Ug2der(2,2,i-2)=0.0d0
2369 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2370 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2371 iti = itortyp(itype(i-2))
2375 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2376 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2377 iti1 = itortyp(itype(i-1))
2381 cd write (iout,*) '*******i',i,' iti1',iti
2382 cd write (iout,*) 'b1',b1(:,iti)
2383 cd write (iout,*) 'b2',b2(:,iti)
2384 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2385 c if (i .gt. iatel_s+2) then
2386 if (i .gt. nnt+2) then
2387 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2388 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2389 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2391 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2392 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2393 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2394 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2395 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2406 DtUg2(l,k,i-2)=0.0d0
2410 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2411 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2413 muder(k,i-2)=Ub2der(k,i-2)
2415 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2416 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2417 if (itype(i-1).le.ntyp) then
2418 iti1 = itortyp(itype(i-1))
2426 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2428 cd write (iout,*) 'mu ',mu(:,i-2)
2429 cd write (iout,*) 'mu1',mu1(:,i-2)
2430 cd write (iout,*) 'mu2',mu2(:,i-2)
2431 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2433 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2434 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2435 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2436 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2437 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2438 C Vectors and matrices dependent on a single virtual-bond dihedral.
2439 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2440 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2441 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2442 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2443 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2444 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2445 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2446 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2447 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2450 C Matrices dependent on two consecutive virtual-bond dihedrals.
2451 C The order of matrices is from left to right.
2452 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2454 c do i=max0(ivec_start,2),ivec_end
2456 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2457 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2458 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2459 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2460 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2461 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2462 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2463 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2466 #if defined(MPI) && defined(PARMAT)
2468 c if (fg_rank.eq.0) then
2469 write (iout,*) "Arrays UG and UGDER before GATHER"
2471 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2472 & ((ug(l,k,i),l=1,2),k=1,2),
2473 & ((ugder(l,k,i),l=1,2),k=1,2)
2475 write (iout,*) "Arrays UG2 and UG2DER"
2477 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2478 & ((ug2(l,k,i),l=1,2),k=1,2),
2479 & ((ug2der(l,k,i),l=1,2),k=1,2)
2481 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2483 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2484 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2485 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2487 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2489 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2490 & costab(i),sintab(i),costab2(i),sintab2(i)
2492 write (iout,*) "Array MUDER"
2494 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2498 if (nfgtasks.gt.1) then
2500 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2501 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2502 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2504 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2505 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2507 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2508 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2510 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2511 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2513 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2514 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2516 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2517 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2519 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2520 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2522 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2523 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2524 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2525 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2526 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2527 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2528 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2529 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2530 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2531 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2532 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2533 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2534 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2536 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2537 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2539 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2540 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2542 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2543 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2545 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2546 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2548 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2549 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2551 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2552 & ivec_count(fg_rank1),
2553 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2555 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2556 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2558 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2559 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2561 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2562 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2564 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2565 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2567 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2568 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2570 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2571 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2573 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2574 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2576 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2577 & ivec_count(fg_rank1),
2578 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2580 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2581 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2583 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2584 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2586 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2587 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2589 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2590 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2592 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2593 & ivec_count(fg_rank1),
2594 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2596 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2597 & ivec_count(fg_rank1),
2598 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2600 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2601 & ivec_count(fg_rank1),
2602 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2603 & MPI_MAT2,FG_COMM1,IERR)
2604 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2605 & ivec_count(fg_rank1),
2606 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2607 & MPI_MAT2,FG_COMM1,IERR)
2610 c Passes matrix info through the ring
2613 if (irecv.lt.0) irecv=nfgtasks1-1
2616 if (inext.ge.nfgtasks1) inext=0
2618 c write (iout,*) "isend",isend," irecv",irecv
2620 lensend=lentyp(isend)
2621 lenrecv=lentyp(irecv)
2622 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2623 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2624 c & MPI_ROTAT1(lensend),inext,2200+isend,
2625 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2626 c & iprev,2200+irecv,FG_COMM,status,IERR)
2627 c write (iout,*) "Gather ROTAT1"
2629 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2630 c & MPI_ROTAT2(lensend),inext,3300+isend,
2631 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2632 c & iprev,3300+irecv,FG_COMM,status,IERR)
2633 c write (iout,*) "Gather ROTAT2"
2635 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2636 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2637 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2638 & iprev,4400+irecv,FG_COMM,status,IERR)
2639 c write (iout,*) "Gather ROTAT_OLD"
2641 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2642 & MPI_PRECOMP11(lensend),inext,5500+isend,
2643 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2644 & iprev,5500+irecv,FG_COMM,status,IERR)
2645 c write (iout,*) "Gather PRECOMP11"
2647 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2648 & MPI_PRECOMP12(lensend),inext,6600+isend,
2649 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2650 & iprev,6600+irecv,FG_COMM,status,IERR)
2651 c write (iout,*) "Gather PRECOMP12"
2653 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2655 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2656 & MPI_ROTAT2(lensend),inext,7700+isend,
2657 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2658 & iprev,7700+irecv,FG_COMM,status,IERR)
2659 c write (iout,*) "Gather PRECOMP21"
2661 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2662 & MPI_PRECOMP22(lensend),inext,8800+isend,
2663 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2664 & iprev,8800+irecv,FG_COMM,status,IERR)
2665 c write (iout,*) "Gather PRECOMP22"
2667 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2668 & MPI_PRECOMP23(lensend),inext,9900+isend,
2669 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2670 & MPI_PRECOMP23(lenrecv),
2671 & iprev,9900+irecv,FG_COMM,status,IERR)
2672 c write (iout,*) "Gather PRECOMP23"
2677 if (irecv.lt.0) irecv=nfgtasks1-1
2680 time_gather=time_gather+MPI_Wtime()-time00
2683 c if (fg_rank.eq.0) then
2684 write (iout,*) "Arrays UG and UGDER"
2686 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2687 & ((ug(l,k,i),l=1,2),k=1,2),
2688 & ((ugder(l,k,i),l=1,2),k=1,2)
2690 write (iout,*) "Arrays UG2 and UG2DER"
2692 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2693 & ((ug2(l,k,i),l=1,2),k=1,2),
2694 & ((ug2der(l,k,i),l=1,2),k=1,2)
2696 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2698 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2699 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2700 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2702 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2704 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2705 & costab(i),sintab(i),costab2(i),sintab2(i)
2707 write (iout,*) "Array MUDER"
2709 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2715 cd iti = itortyp(itype(i))
2718 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2719 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2724 C--------------------------------------------------------------------------
2725 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2727 C This subroutine calculates the average interaction energy and its gradient
2728 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2729 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2730 C The potential depends both on the distance of peptide-group centers and on
2731 C the orientation of the CA-CA virtual bonds.
2733 implicit real*8 (a-h,o-z)
2737 include 'DIMENSIONS'
2738 include 'COMMON.CONTROL'
2739 include 'COMMON.SETUP'
2740 include 'COMMON.IOUNITS'
2741 include 'COMMON.GEO'
2742 include 'COMMON.VAR'
2743 include 'COMMON.LOCAL'
2744 include 'COMMON.CHAIN'
2745 include 'COMMON.DERIV'
2746 include 'COMMON.INTERACT'
2747 include 'COMMON.CONTACTS'
2748 include 'COMMON.TORSION'
2749 include 'COMMON.VECTORS'
2750 include 'COMMON.FFIELD'
2751 include 'COMMON.TIME1'
2752 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2753 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2754 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2755 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2756 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2757 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2759 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2761 double precision scal_el /1.0d0/
2763 double precision scal_el /0.5d0/
2766 C 13-go grudnia roku pamietnego...
2767 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2768 & 0.0d0,1.0d0,0.0d0,
2769 & 0.0d0,0.0d0,1.0d0/
2770 cd write(iout,*) 'In EELEC'
2772 cd write(iout,*) 'Type',i
2773 cd write(iout,*) 'B1',B1(:,i)
2774 cd write(iout,*) 'B2',B2(:,i)
2775 cd write(iout,*) 'CC',CC(:,:,i)
2776 cd write(iout,*) 'DD',DD(:,:,i)
2777 cd write(iout,*) 'EE',EE(:,:,i)
2779 cd call check_vecgrad
2781 if (icheckgrad.eq.1) then
2783 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2785 dc_norm(k,i)=dc(k,i)*fac
2787 c write (iout,*) 'i',i,' fac',fac
2790 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2791 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2792 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2793 c call vec_and_deriv
2799 time_mat=time_mat+MPI_Wtime()-time01
2803 cd write (iout,*) 'i=',i
2805 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2808 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2809 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2822 cd print '(a)','Enter EELEC'
2823 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2825 gel_loc_loc(i)=0.0d0
2830 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2832 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2834 do i=iturn3_start,iturn3_end
2835 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2836 & .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
2840 dx_normi=dc_norm(1,i)
2841 dy_normi=dc_norm(2,i)
2842 dz_normi=dc_norm(3,i)
2843 xmedi=c(1,i)+0.5d0*dxi
2844 ymedi=c(2,i)+0.5d0*dyi
2845 zmedi=c(3,i)+0.5d0*dzi
2847 call eelecij(i,i+2,ees,evdw1,eel_loc)
2848 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2849 num_cont_hb(i)=num_conti
2851 do i=iturn4_start,iturn4_end
2852 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2853 & .or. itype(i+3).eq.ntyp1
2854 & .or. itype(i+4).eq.ntyp1) cycle
2858 dx_normi=dc_norm(1,i)
2859 dy_normi=dc_norm(2,i)
2860 dz_normi=dc_norm(3,i)
2861 xmedi=c(1,i)+0.5d0*dxi
2862 ymedi=c(2,i)+0.5d0*dyi
2863 zmedi=c(3,i)+0.5d0*dzi
2864 num_conti=num_cont_hb(i)
2865 call eelecij(i,i+3,ees,evdw1,eel_loc)
2866 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2867 & call eturn4(i,eello_turn4)
2868 num_cont_hb(i)=num_conti
2871 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2873 do i=iatel_s,iatel_e
2874 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2878 dx_normi=dc_norm(1,i)
2879 dy_normi=dc_norm(2,i)
2880 dz_normi=dc_norm(3,i)
2881 xmedi=c(1,i)+0.5d0*dxi
2882 ymedi=c(2,i)+0.5d0*dyi
2883 zmedi=c(3,i)+0.5d0*dzi
2884 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2885 num_conti=num_cont_hb(i)
2886 do j=ielstart(i),ielend(i)
2887 c write (iout,*) i,j,itype(i),itype(j)
2888 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2889 call eelecij(i,j,ees,evdw1,eel_loc)
2891 num_cont_hb(i)=num_conti
2893 c write (iout,*) "Number of loop steps in EELEC:",ind
2895 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2896 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2898 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2899 ccc eel_loc=eel_loc+eello_turn3
2900 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2903 C-------------------------------------------------------------------------------
2904 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2905 implicit real*8 (a-h,o-z)
2906 include 'DIMENSIONS'
2910 include 'COMMON.CONTROL'
2911 include 'COMMON.IOUNITS'
2912 include 'COMMON.GEO'
2913 include 'COMMON.VAR'
2914 include 'COMMON.LOCAL'
2915 include 'COMMON.CHAIN'
2916 include 'COMMON.DERIV'
2917 include 'COMMON.INTERACT'
2918 include 'COMMON.CONTACTS'
2919 include 'COMMON.TORSION'
2920 include 'COMMON.VECTORS'
2921 include 'COMMON.FFIELD'
2922 include 'COMMON.TIME1'
2923 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2924 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2925 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2926 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2927 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2928 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2930 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2932 double precision scal_el /1.0d0/
2934 double precision scal_el /0.5d0/
2937 C 13-go grudnia roku pamietnego...
2938 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2939 & 0.0d0,1.0d0,0.0d0,
2940 & 0.0d0,0.0d0,1.0d0/
2941 c time00=MPI_Wtime()
2942 cd write (iout,*) "eelecij",i,j
2946 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2947 aaa=app(iteli,itelj)
2948 bbb=bpp(iteli,itelj)
2949 ael6i=ael6(iteli,itelj)
2950 ael3i=ael3(iteli,itelj)
2954 dx_normj=dc_norm(1,j)
2955 dy_normj=dc_norm(2,j)
2956 dz_normj=dc_norm(3,j)
2957 xj=c(1,j)+0.5D0*dxj-xmedi
2958 yj=c(2,j)+0.5D0*dyj-ymedi
2959 zj=c(3,j)+0.5D0*dzj-zmedi
2960 rij=xj*xj+yj*yj+zj*zj
2966 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2967 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2968 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2969 fac=cosa-3.0D0*cosb*cosg
2971 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2972 if (j.eq.i+2) ev1=scal_el*ev1
2977 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2980 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2981 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2984 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2985 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2986 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2987 cd & xmedi,ymedi,zmedi,xj,yj,zj
2989 if (energy_dec) then
2990 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
2992 &,iteli,itelj,aaa,evdw1
2993 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2997 C Calculate contributions to the Cartesian gradient.
3000 facvdw=-6*rrmij*(ev1+evdwij)
3001 facel=-3*rrmij*(el1+eesij)
3007 * Radial derivatives. First process both termini of the fragment (i,j)
3013 c ghalf=0.5D0*ggg(k)
3014 c gelc(k,i)=gelc(k,i)+ghalf
3015 c gelc(k,j)=gelc(k,j)+ghalf
3017 c 9/28/08 AL Gradient compotents will be summed only at the end
3019 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3020 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3023 * Loop over residues i+1 thru j-1.
3027 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3034 c ghalf=0.5D0*ggg(k)
3035 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3036 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3038 c 9/28/08 AL Gradient compotents will be summed only at the end
3040 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3041 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3044 * Loop over residues i+1 thru j-1.
3048 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3055 fac=-3*rrmij*(facvdw+facvdw+facel)
3060 * Radial derivatives. First process both termini of the fragment (i,j)
3066 c ghalf=0.5D0*ggg(k)
3067 c gelc(k,i)=gelc(k,i)+ghalf
3068 c gelc(k,j)=gelc(k,j)+ghalf
3070 c 9/28/08 AL Gradient compotents will be summed only at the end
3072 gelc_long(k,j)=gelc(k,j)+ggg(k)
3073 gelc_long(k,i)=gelc(k,i)-ggg(k)
3076 * Loop over residues i+1 thru j-1.
3080 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3083 c 9/28/08 AL Gradient compotents will be summed only at the end
3088 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3089 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3095 ecosa=2.0D0*fac3*fac1+fac4
3098 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3099 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3101 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3102 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3104 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3105 cd & (dcosg(k),k=1,3)
3107 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3110 c ghalf=0.5D0*ggg(k)
3111 c gelc(k,i)=gelc(k,i)+ghalf
3112 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3113 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3114 c gelc(k,j)=gelc(k,j)+ghalf
3115 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3116 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3120 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3125 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3126 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3128 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3129 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3130 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3131 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3133 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3134 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3135 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3137 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3138 C energy of a peptide unit is assumed in the form of a second-order
3139 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3140 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3141 C are computed for EVERY pair of non-contiguous peptide groups.
3143 if (j.lt.nres-1) then
3154 muij(kkk)=mu(k,i)*mu(l,j)
3157 cd write (iout,*) 'EELEC: i',i,' j',j
3158 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3159 cd write(iout,*) 'muij',muij
3160 ury=scalar(uy(1,i),erij)
3161 urz=scalar(uz(1,i),erij)
3162 vry=scalar(uy(1,j),erij)
3163 vrz=scalar(uz(1,j),erij)
3164 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3165 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3166 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3167 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3168 fac=dsqrt(-ael6i)*r3ij
3173 cd write (iout,'(4i5,4f10.5)')
3174 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3175 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3176 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3177 cd & uy(:,j),uz(:,j)
3178 cd write (iout,'(4f10.5)')
3179 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3180 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3181 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3182 cd write (iout,'(9f10.5/)')
3183 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3184 C Derivatives of the elements of A in virtual-bond vectors
3185 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3187 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3188 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3189 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3190 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3191 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3192 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3193 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3194 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3195 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3196 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3197 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3198 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3200 C Compute radial contributions to the gradient
3218 C Add the contributions coming from er
3221 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3222 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3223 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3224 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3227 C Derivatives in DC(i)
3228 cgrad ghalf1=0.5d0*agg(k,1)
3229 cgrad ghalf2=0.5d0*agg(k,2)
3230 cgrad ghalf3=0.5d0*agg(k,3)
3231 cgrad ghalf4=0.5d0*agg(k,4)
3232 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3233 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3234 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3235 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3236 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3237 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3238 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3239 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3240 C Derivatives in DC(i+1)
3241 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3242 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3243 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3244 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3245 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3246 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3247 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3248 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3249 C Derivatives in DC(j)
3250 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3251 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3252 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3253 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3254 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3255 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3256 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3257 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3258 C Derivatives in DC(j+1) or DC(nres-1)
3259 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3260 & -3.0d0*vryg(k,3)*ury)
3261 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3262 & -3.0d0*vrzg(k,3)*ury)
3263 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3264 & -3.0d0*vryg(k,3)*urz)
3265 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3266 & -3.0d0*vrzg(k,3)*urz)
3267 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3269 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3282 aggi(k,l)=-aggi(k,l)
3283 aggi1(k,l)=-aggi1(k,l)
3284 aggj(k,l)=-aggj(k,l)
3285 aggj1(k,l)=-aggj1(k,l)
3288 if (j.lt.nres-1) then
3294 aggi(k,l)=-aggi(k,l)
3295 aggi1(k,l)=-aggi1(k,l)
3296 aggj(k,l)=-aggj(k,l)
3297 aggj1(k,l)=-aggj1(k,l)
3308 aggi(k,l)=-aggi(k,l)
3309 aggi1(k,l)=-aggi1(k,l)
3310 aggj(k,l)=-aggj(k,l)
3311 aggj1(k,l)=-aggj1(k,l)
3316 IF (wel_loc.gt.0.0d0) THEN
3317 C Contribution to the local-electrostatic energy coming from the i-j pair
3318 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3320 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3322 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3323 & 'eelloc',i,j,eel_loc_ij
3324 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3326 eel_loc=eel_loc+eel_loc_ij
3327 C Partial derivatives in virtual-bond dihedral angles gamma
3329 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3330 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3331 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3332 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3333 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3334 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3335 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3337 ggg(l)=agg(l,1)*muij(1)+
3338 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3339 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3340 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3341 cgrad ghalf=0.5d0*ggg(l)
3342 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3343 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3347 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3350 C Remaining derivatives of eello
3352 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3353 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3354 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3355 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3356 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3357 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3358 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3359 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3362 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3363 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3364 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3365 & .and. num_conti.le.maxconts) then
3366 c write (iout,*) i,j," entered corr"
3368 C Calculate the contact function. The ith column of the array JCONT will
3369 C contain the numbers of atoms that make contacts with the atom I (of numbers
3370 C greater than I). The arrays FACONT and GACONT will contain the values of
3371 C the contact function and its derivative.
3372 c r0ij=1.02D0*rpp(iteli,itelj)
3373 c r0ij=1.11D0*rpp(iteli,itelj)
3374 r0ij=2.20D0*rpp(iteli,itelj)
3375 c r0ij=1.55D0*rpp(iteli,itelj)
3376 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3377 if (fcont.gt.0.0D0) then
3378 num_conti=num_conti+1
3379 if (num_conti.gt.maxconts) then
3380 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3381 & ' will skip next contacts for this conf.'
3383 jcont_hb(num_conti,i)=j
3384 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3385 cd & " jcont_hb",jcont_hb(num_conti,i)
3386 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3387 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3388 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3390 d_cont(num_conti,i)=rij
3391 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3392 C --- Electrostatic-interaction matrix ---
3393 a_chuj(1,1,num_conti,i)=a22
3394 a_chuj(1,2,num_conti,i)=a23
3395 a_chuj(2,1,num_conti,i)=a32
3396 a_chuj(2,2,num_conti,i)=a33
3397 C --- Gradient of rij
3399 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3406 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3407 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3408 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3409 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3410 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3415 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3416 C Calculate contact energies
3418 wij=cosa-3.0D0*cosb*cosg
3421 c fac3=dsqrt(-ael6i)/r0ij**3
3422 fac3=dsqrt(-ael6i)*r3ij
3423 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3424 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3425 if (ees0tmp.gt.0) then
3426 ees0pij=dsqrt(ees0tmp)
3430 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3431 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3432 if (ees0tmp.gt.0) then
3433 ees0mij=dsqrt(ees0tmp)
3438 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3439 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3440 C Diagnostics. Comment out or remove after debugging!
3441 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3442 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3443 c ees0m(num_conti,i)=0.0D0
3445 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3446 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3447 C Angular derivatives of the contact function
3448 ees0pij1=fac3/ees0pij
3449 ees0mij1=fac3/ees0mij
3450 fac3p=-3.0D0*fac3*rrmij
3451 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3452 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3454 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3455 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3456 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3457 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3458 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3459 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3460 ecosap=ecosa1+ecosa2
3461 ecosbp=ecosb1+ecosb2
3462 ecosgp=ecosg1+ecosg2
3463 ecosam=ecosa1-ecosa2
3464 ecosbm=ecosb1-ecosb2
3465 ecosgm=ecosg1-ecosg2
3474 facont_hb(num_conti,i)=fcont
3475 fprimcont=fprimcont/rij
3476 cd facont_hb(num_conti,i)=1.0D0
3477 C Following line is for diagnostics.
3480 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3481 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3484 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3485 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3487 gggp(1)=gggp(1)+ees0pijp*xj
3488 gggp(2)=gggp(2)+ees0pijp*yj
3489 gggp(3)=gggp(3)+ees0pijp*zj
3490 gggm(1)=gggm(1)+ees0mijp*xj
3491 gggm(2)=gggm(2)+ees0mijp*yj
3492 gggm(3)=gggm(3)+ees0mijp*zj
3493 C Derivatives due to the contact function
3494 gacont_hbr(1,num_conti,i)=fprimcont*xj
3495 gacont_hbr(2,num_conti,i)=fprimcont*yj
3496 gacont_hbr(3,num_conti,i)=fprimcont*zj
3499 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3500 c following the change of gradient-summation algorithm.
3502 cgrad ghalfp=0.5D0*gggp(k)
3503 cgrad ghalfm=0.5D0*gggm(k)
3504 gacontp_hb1(k,num_conti,i)=!ghalfp
3505 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3506 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3507 gacontp_hb2(k,num_conti,i)=!ghalfp
3508 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3509 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3510 gacontp_hb3(k,num_conti,i)=gggp(k)
3511 gacontm_hb1(k,num_conti,i)=!ghalfm
3512 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3513 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3514 gacontm_hb2(k,num_conti,i)=!ghalfm
3515 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3516 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3517 gacontm_hb3(k,num_conti,i)=gggm(k)
3519 C Diagnostics. Comment out or remove after debugging!
3521 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3522 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3523 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3524 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3525 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3526 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3529 endif ! num_conti.le.maxconts
3532 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3535 ghalf=0.5d0*agg(l,k)
3536 aggi(l,k)=aggi(l,k)+ghalf
3537 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3538 aggj(l,k)=aggj(l,k)+ghalf
3541 if (j.eq.nres-1 .and. i.lt.j-2) then
3544 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3549 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3552 C-----------------------------------------------------------------------------
3553 subroutine eturn3(i,eello_turn3)
3554 C Third- and fourth-order contributions from turns
3555 implicit real*8 (a-h,o-z)
3556 include 'DIMENSIONS'
3557 include 'COMMON.IOUNITS'
3558 include 'COMMON.GEO'
3559 include 'COMMON.VAR'
3560 include 'COMMON.LOCAL'
3561 include 'COMMON.CHAIN'
3562 include 'COMMON.DERIV'
3563 include 'COMMON.INTERACT'
3564 include 'COMMON.CONTACTS'
3565 include 'COMMON.TORSION'
3566 include 'COMMON.VECTORS'
3567 include 'COMMON.FFIELD'
3568 include 'COMMON.CONTROL'
3570 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3571 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3572 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3573 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3574 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3575 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3576 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3579 c write (iout,*) "eturn3",i,j,j1,j2
3584 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3586 C Third-order contributions
3593 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3594 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3595 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3596 call transpose2(auxmat(1,1),auxmat1(1,1))
3597 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3598 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3599 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3600 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3601 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3602 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3603 cd & ' eello_turn3_num',4*eello_turn3_num
3604 C Derivatives in gamma(i)
3605 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3606 call transpose2(auxmat2(1,1),auxmat3(1,1))
3607 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3608 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3609 C Derivatives in gamma(i+1)
3610 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3611 call transpose2(auxmat2(1,1),auxmat3(1,1))
3612 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3613 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3614 & +0.5d0*(pizda(1,1)+pizda(2,2))
3615 C Cartesian derivatives
3617 c ghalf1=0.5d0*agg(l,1)
3618 c ghalf2=0.5d0*agg(l,2)
3619 c ghalf3=0.5d0*agg(l,3)
3620 c ghalf4=0.5d0*agg(l,4)
3621 a_temp(1,1)=aggi(l,1)!+ghalf1
3622 a_temp(1,2)=aggi(l,2)!+ghalf2
3623 a_temp(2,1)=aggi(l,3)!+ghalf3
3624 a_temp(2,2)=aggi(l,4)!+ghalf4
3625 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3626 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3627 & +0.5d0*(pizda(1,1)+pizda(2,2))
3628 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3629 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3630 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3631 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3632 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3633 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3634 & +0.5d0*(pizda(1,1)+pizda(2,2))
3635 a_temp(1,1)=aggj(l,1)!+ghalf1
3636 a_temp(1,2)=aggj(l,2)!+ghalf2
3637 a_temp(2,1)=aggj(l,3)!+ghalf3
3638 a_temp(2,2)=aggj(l,4)!+ghalf4
3639 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3640 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3641 & +0.5d0*(pizda(1,1)+pizda(2,2))
3642 a_temp(1,1)=aggj1(l,1)
3643 a_temp(1,2)=aggj1(l,2)
3644 a_temp(2,1)=aggj1(l,3)
3645 a_temp(2,2)=aggj1(l,4)
3646 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3647 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3648 & +0.5d0*(pizda(1,1)+pizda(2,2))
3652 C-------------------------------------------------------------------------------
3653 subroutine eturn4(i,eello_turn4)
3654 C Third- and fourth-order contributions from turns
3655 implicit real*8 (a-h,o-z)
3656 include 'DIMENSIONS'
3657 include 'COMMON.IOUNITS'
3658 include 'COMMON.GEO'
3659 include 'COMMON.VAR'
3660 include 'COMMON.LOCAL'
3661 include 'COMMON.CHAIN'
3662 include 'COMMON.DERIV'
3663 include 'COMMON.INTERACT'
3664 include 'COMMON.CONTACTS'
3665 include 'COMMON.TORSION'
3666 include 'COMMON.VECTORS'
3667 include 'COMMON.FFIELD'
3668 include 'COMMON.CONTROL'
3670 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3671 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3672 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3673 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3674 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3675 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3676 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3679 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3681 C Fourth-order contributions
3689 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3690 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3691 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3696 iti1=itortyp(itype(i+1))
3697 iti2=itortyp(itype(i+2))
3698 iti3=itortyp(itype(i+3))
3699 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3700 call transpose2(EUg(1,1,i+1),e1t(1,1))
3701 call transpose2(Eug(1,1,i+2),e2t(1,1))
3702 call transpose2(Eug(1,1,i+3),e3t(1,1))
3703 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3704 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3705 s1=scalar2(b1(1,iti2),auxvec(1))
3706 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3707 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3708 s2=scalar2(b1(1,iti1),auxvec(1))
3709 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3710 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3711 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3712 eello_turn4=eello_turn4-(s1+s2+s3)
3713 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3714 & 'eturn4',i,j,-(s1+s2+s3)
3715 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3716 cd & ' eello_turn4_num',8*eello_turn4_num
3717 C Derivatives in gamma(i)
3718 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3719 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3720 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3721 s1=scalar2(b1(1,iti2),auxvec(1))
3722 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3723 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3724 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3725 C Derivatives in gamma(i+1)
3726 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3727 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3728 s2=scalar2(b1(1,iti1),auxvec(1))
3729 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3730 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3731 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3732 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3733 C Derivatives in gamma(i+2)
3734 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3735 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3736 s1=scalar2(b1(1,iti2),auxvec(1))
3737 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3738 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3739 s2=scalar2(b1(1,iti1),auxvec(1))
3740 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3741 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3742 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3743 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3744 C Cartesian derivatives
3745 C Derivatives of this turn contributions in DC(i+2)
3746 if (j.lt.nres-1) then
3748 a_temp(1,1)=agg(l,1)
3749 a_temp(1,2)=agg(l,2)
3750 a_temp(2,1)=agg(l,3)
3751 a_temp(2,2)=agg(l,4)
3752 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3753 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3754 s1=scalar2(b1(1,iti2),auxvec(1))
3755 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3756 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3757 s2=scalar2(b1(1,iti1),auxvec(1))
3758 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3759 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3760 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3762 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3765 C Remaining derivatives of this turn contribution
3767 a_temp(1,1)=aggi(l,1)
3768 a_temp(1,2)=aggi(l,2)
3769 a_temp(2,1)=aggi(l,3)
3770 a_temp(2,2)=aggi(l,4)
3771 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3772 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3773 s1=scalar2(b1(1,iti2),auxvec(1))
3774 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3775 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3776 s2=scalar2(b1(1,iti1),auxvec(1))
3777 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3778 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3779 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3780 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3781 a_temp(1,1)=aggi1(l,1)
3782 a_temp(1,2)=aggi1(l,2)
3783 a_temp(2,1)=aggi1(l,3)
3784 a_temp(2,2)=aggi1(l,4)
3785 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3786 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3787 s1=scalar2(b1(1,iti2),auxvec(1))
3788 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3789 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3790 s2=scalar2(b1(1,iti1),auxvec(1))
3791 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3792 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3793 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3794 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3795 a_temp(1,1)=aggj(l,1)
3796 a_temp(1,2)=aggj(l,2)
3797 a_temp(2,1)=aggj(l,3)
3798 a_temp(2,2)=aggj(l,4)
3799 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3800 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3801 s1=scalar2(b1(1,iti2),auxvec(1))
3802 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3803 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3804 s2=scalar2(b1(1,iti1),auxvec(1))
3805 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3806 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3807 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3808 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3809 a_temp(1,1)=aggj1(l,1)
3810 a_temp(1,2)=aggj1(l,2)
3811 a_temp(2,1)=aggj1(l,3)
3812 a_temp(2,2)=aggj1(l,4)
3813 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3814 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3815 s1=scalar2(b1(1,iti2),auxvec(1))
3816 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3817 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3818 s2=scalar2(b1(1,iti1),auxvec(1))
3819 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3820 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3821 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3822 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3823 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3827 C-----------------------------------------------------------------------------
3828 subroutine vecpr(u,v,w)
3829 implicit real*8(a-h,o-z)
3830 dimension u(3),v(3),w(3)
3831 w(1)=u(2)*v(3)-u(3)*v(2)
3832 w(2)=-u(1)*v(3)+u(3)*v(1)
3833 w(3)=u(1)*v(2)-u(2)*v(1)
3836 C-----------------------------------------------------------------------------
3837 subroutine unormderiv(u,ugrad,unorm,ungrad)
3838 C This subroutine computes the derivatives of a normalized vector u, given
3839 C the derivatives computed without normalization conditions, ugrad. Returns
3842 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3843 double precision vec(3)
3844 double precision scalar
3846 c write (2,*) 'ugrad',ugrad
3849 vec(i)=scalar(ugrad(1,i),u(1))
3851 c write (2,*) 'vec',vec
3854 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3857 c write (2,*) 'ungrad',ungrad
3860 C-----------------------------------------------------------------------------
3861 subroutine escp_soft_sphere(evdw2,evdw2_14)
3863 C This subroutine calculates the excluded-volume interaction energy between
3864 C peptide-group centers and side chains and its gradient in virtual-bond and
3865 C side-chain vectors.
3867 implicit real*8 (a-h,o-z)
3868 include 'DIMENSIONS'
3869 include 'COMMON.GEO'
3870 include 'COMMON.VAR'
3871 include 'COMMON.LOCAL'
3872 include 'COMMON.CHAIN'
3873 include 'COMMON.DERIV'
3874 include 'COMMON.INTERACT'
3875 include 'COMMON.FFIELD'
3876 include 'COMMON.IOUNITS'
3877 include 'COMMON.CONTROL'
3882 cd print '(a)','Enter ESCP'
3883 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3884 do i=iatscp_s,iatscp_e
3885 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3887 xi=0.5D0*(c(1,i)+c(1,i+1))
3888 yi=0.5D0*(c(2,i)+c(2,i+1))
3889 zi=0.5D0*(c(3,i)+c(3,i+1))
3891 do iint=1,nscp_gr(i)
3893 do j=iscpstart(i,iint),iscpend(i,iint)
3894 if (itype(j).eq.ntyp1) cycle
3895 itypj=iabs(itype(j))
3896 C Uncomment following three lines for SC-p interactions
3900 C Uncomment following three lines for Ca-p interactions
3904 rij=xj*xj+yj*yj+zj*zj
3907 if (rij.lt.r0ijsq) then
3908 evdwij=0.25d0*(rij-r0ijsq)**2
3916 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3921 cgrad if (j.lt.i) then
3922 cd write (iout,*) 'j<i'
3923 C Uncomment following three lines for SC-p interactions
3925 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3928 cd write (iout,*) 'j>i'
3930 cgrad ggg(k)=-ggg(k)
3931 C Uncomment following line for SC-p interactions
3932 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3936 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3938 cgrad kstart=min0(i+1,j)
3939 cgrad kend=max0(i-1,j-1)
3940 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3941 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3942 cgrad do k=kstart,kend
3944 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3948 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3949 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3957 C-----------------------------------------------------------------------------
3958 subroutine escp(evdw2,evdw2_14)
3960 C This subroutine calculates the excluded-volume interaction energy between
3961 C peptide-group centers and side chains and its gradient in virtual-bond and
3962 C side-chain vectors.
3964 implicit real*8 (a-h,o-z)
3965 include 'DIMENSIONS'
3966 include 'COMMON.GEO'
3967 include 'COMMON.VAR'
3968 include 'COMMON.LOCAL'
3969 include 'COMMON.CHAIN'
3970 include 'COMMON.DERIV'
3971 include 'COMMON.INTERACT'
3972 include 'COMMON.FFIELD'
3973 include 'COMMON.IOUNITS'
3974 include 'COMMON.CONTROL'
3978 cd print '(a)','Enter ESCP'
3979 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3980 do i=iatscp_s,iatscp_e
3981 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3983 xi=0.5D0*(c(1,i)+c(1,i+1))
3984 yi=0.5D0*(c(2,i)+c(2,i+1))
3985 zi=0.5D0*(c(3,i)+c(3,i+1))
3987 do iint=1,nscp_gr(i)
3989 do j=iscpstart(i,iint),iscpend(i,iint)
3990 itypj=iabs(itype(j))
3991 if (itypj.eq.ntyp1) cycle
3992 C Uncomment following three lines for SC-p interactions
3996 C Uncomment following three lines for Ca-p interactions
4000 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4002 e1=fac*fac*aad(itypj,iteli)
4003 e2=fac*bad(itypj,iteli)
4004 if (iabs(j-i) .le. 2) then
4007 evdw2_14=evdw2_14+e1+e2
4011 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4012 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4015 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4017 fac=-(evdwij+e1)*rrij
4021 cgrad if (j.lt.i) then
4022 cd write (iout,*) 'j<i'
4023 C Uncomment following three lines for SC-p interactions
4025 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4028 cd write (iout,*) 'j>i'
4030 cgrad ggg(k)=-ggg(k)
4031 C Uncomment following line for SC-p interactions
4032 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4033 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4037 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4039 cgrad kstart=min0(i+1,j)
4040 cgrad kend=max0(i-1,j-1)
4041 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4042 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4043 cgrad do k=kstart,kend
4045 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4049 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4050 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4058 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4059 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4060 gradx_scp(j,i)=expon*gradx_scp(j,i)
4063 C******************************************************************************
4067 C To save time the factor EXPON has been extracted from ALL components
4068 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4071 C******************************************************************************
4074 C--------------------------------------------------------------------------
4075 subroutine edis(ehpb)
4077 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4079 implicit real*8 (a-h,o-z)
4080 include 'DIMENSIONS'
4081 include 'COMMON.SBRIDGE'
4082 include 'COMMON.CHAIN'
4083 include 'COMMON.DERIV'
4084 include 'COMMON.VAR'
4085 include 'COMMON.INTERACT'
4086 include 'COMMON.IOUNITS'
4087 include 'COMMON.CONTROL'
4090 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4091 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4092 if (link_end.eq.0) return
4093 do i=link_start,link_end
4094 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4095 C CA-CA distance used in regularization of structure.
4098 C iii and jjj point to the residues for which the distance is assigned.
4099 if (ii.gt.nres) then
4106 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4107 c & dhpb(i),dhpb1(i),forcon(i)
4108 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4109 C distance and angle dependent SS bond potential.
4110 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4111 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4112 if (.not.dyn_ss .and. i.le.nss) then
4113 C 15/02/13 CC dynamic SSbond - additional check
4114 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4115 & iabs(itype(jjj)).eq.1) then
4116 call ssbond_ene(iii,jjj,eij)
4119 cd write (iout,*) "eij",eij
4120 cd & ' waga=',waga,' fac=',fac
4121 else if (ii.gt.nres .and. jj.gt.nres) then
4122 c Restraints from contact prediction
4124 if (constr_dist.eq.11) then
4125 ehpb=ehpb+fordepth(i)**4
4126 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4128 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4130 if (dhpb1(i).gt.0.0d0) then
4131 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4132 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4133 c write (iout,*) "beta nmr",
4134 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4138 C Get the force constant corresponding to this distance.
4140 C Calculate the contribution to energy.
4141 ehpb=ehpb+waga*rdis*rdis
4142 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4144 C Evaluate gradient.
4150 ggg(j)=fac*(c(j,jj)-c(j,ii))
4153 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4154 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4157 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4158 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4161 C Calculate the distance between the two points and its difference from the
4164 if (constr_dist.eq.11) then
4165 ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
4166 fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
4168 if (dhpb1(i).gt.0.0d0) then
4169 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4170 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4171 c write (iout,*) "alph nmr",
4172 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4175 C Get the force constant corresponding to this distance.
4177 C Calculate the contribution to energy.
4178 ehpb=ehpb+waga*rdis*rdis
4179 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4181 C Evaluate gradient.
4187 ggg(j)=fac*(c(j,jj)-c(j,ii))
4189 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4190 C If this is a SC-SC distance, we need to calculate the contributions to the
4191 C Cartesian gradient in the SC vectors (ghpbx).
4194 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4195 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4198 cgrad do j=iii,jjj-1
4200 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4204 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4205 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4209 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
4212 C--------------------------------------------------------------------------
4213 subroutine ssbond_ene(i,j,eij)
4215 C Calculate the distance and angle dependent SS-bond potential energy
4216 C using a free-energy function derived based on RHF/6-31G** ab initio
4217 C calculations of diethyl disulfide.
4219 C A. Liwo and U. Kozlowska, 11/24/03
4221 implicit real*8 (a-h,o-z)
4222 include 'DIMENSIONS'
4223 include 'COMMON.SBRIDGE'
4224 include 'COMMON.CHAIN'
4225 include 'COMMON.DERIV'
4226 include 'COMMON.LOCAL'
4227 include 'COMMON.INTERACT'
4228 include 'COMMON.VAR'
4229 include 'COMMON.IOUNITS'
4230 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4231 itypi=iabs(itype(i))
4235 dxi=dc_norm(1,nres+i)
4236 dyi=dc_norm(2,nres+i)
4237 dzi=dc_norm(3,nres+i)
4238 c dsci_inv=dsc_inv(itypi)
4239 dsci_inv=vbld_inv(nres+i)
4240 itypj=iabs(itype(j))
4241 c dscj_inv=dsc_inv(itypj)
4242 dscj_inv=vbld_inv(nres+j)
4246 dxj=dc_norm(1,nres+j)
4247 dyj=dc_norm(2,nres+j)
4248 dzj=dc_norm(3,nres+j)
4249 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4254 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4255 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4256 om12=dxi*dxj+dyi*dyj+dzi*dzj
4258 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4259 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4265 deltat12=om2-om1+2.0d0
4267 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4268 & +akct*deltad*deltat12
4269 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4270 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4271 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4272 c & " deltat12",deltat12," eij",eij
4273 ed=2*akcm*deltad+akct*deltat12
4275 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4276 eom1=-2*akth*deltat1-pom1-om2*pom2
4277 eom2= 2*akth*deltat2+pom1-om1*pom2
4280 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4281 ghpbx(k,i)=ghpbx(k,i)-ggk
4282 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4283 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4284 ghpbx(k,j)=ghpbx(k,j)+ggk
4285 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4286 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4287 ghpbc(k,i)=ghpbc(k,i)-ggk
4288 ghpbc(k,j)=ghpbc(k,j)+ggk
4291 C Calculate the components of the gradient in DC and X
4295 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4300 C--------------------------------------------------------------------------
4301 subroutine ebond(estr)
4303 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4305 implicit real*8 (a-h,o-z)
4306 include 'DIMENSIONS'
4307 include 'COMMON.LOCAL'
4308 include 'COMMON.GEO'
4309 include 'COMMON.INTERACT'
4310 include 'COMMON.DERIV'
4311 include 'COMMON.VAR'
4312 include 'COMMON.CHAIN'
4313 include 'COMMON.IOUNITS'
4314 include 'COMMON.NAMES'
4315 include 'COMMON.FFIELD'
4316 include 'COMMON.CONTROL'
4317 include 'COMMON.SETUP'
4318 double precision u(3),ud(3)
4321 do i=ibondp_start,ibondp_end
4322 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4323 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4325 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4326 & *dc(j,i-1)/vbld(i)
4328 if (energy_dec) write(iout,*)
4329 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4331 diff = vbld(i)-vbldp0
4332 if (energy_dec) write (iout,*)
4333 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4336 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4338 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4341 estr=0.5d0*AKP*estr+estr1
4343 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4345 do i=ibond_start,ibond_end
4347 if (iti.ne.10 .and. iti.ne.ntyp1) then
4350 diff=vbld(i+nres)-vbldsc0(1,iti)
4351 if (energy_dec) write (iout,*)
4352 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4353 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4354 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4356 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4360 diff=vbld(i+nres)-vbldsc0(j,iti)
4361 ud(j)=aksc(j,iti)*diff
4362 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4376 uprod2=uprod2*u(k)*u(k)
4380 usumsqder=usumsqder+ud(j)*uprod2
4382 estr=estr+uprod/usum
4384 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4392 C--------------------------------------------------------------------------
4393 subroutine ebend(etheta)
4395 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4396 C angles gamma and its derivatives in consecutive thetas and gammas.
4398 implicit real*8 (a-h,o-z)
4399 include 'DIMENSIONS'
4400 include 'COMMON.LOCAL'
4401 include 'COMMON.GEO'
4402 include 'COMMON.INTERACT'
4403 include 'COMMON.DERIV'
4404 include 'COMMON.VAR'
4405 include 'COMMON.CHAIN'
4406 include 'COMMON.IOUNITS'
4407 include 'COMMON.NAMES'
4408 include 'COMMON.FFIELD'
4409 include 'COMMON.CONTROL'
4410 common /calcthet/ term1,term2,termm,diffak,ratak,
4411 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4412 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4413 double precision y(2),z(2)
4415 c time11=dexp(-2*time)
4418 c write (*,'(a,i2)') 'EBEND ICG=',icg
4419 do i=ithet_start,ithet_end
4420 if (itype(i-1).eq.ntyp1) cycle
4421 C Zero the energy function and its derivative at 0 or pi.
4422 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4424 ichir1=isign(1,itype(i-2))
4425 ichir2=isign(1,itype(i))
4426 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4427 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4428 if (itype(i-1).eq.10) then
4429 itype1=isign(10,itype(i-2))
4430 ichir11=isign(1,itype(i-2))
4431 ichir12=isign(1,itype(i-2))
4432 itype2=isign(10,itype(i))
4433 ichir21=isign(1,itype(i))
4434 ichir22=isign(1,itype(i))
4437 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4440 if (phii.ne.phii) phii=150.0
4450 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4453 if (phii1.ne.phii1) phii1=150.0
4465 C Calculate the "mean" value of theta from the part of the distribution
4466 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4467 C In following comments this theta will be referred to as t_c.
4468 thet_pred_mean=0.0d0
4470 athetk=athet(k,it,ichir1,ichir2)
4471 bthetk=bthet(k,it,ichir1,ichir2)
4473 athetk=athet(k,itype1,ichir11,ichir12)
4474 bthetk=bthet(k,itype2,ichir21,ichir22)
4476 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4478 dthett=thet_pred_mean*ssd
4479 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4480 C Derivatives of the "mean" values in gamma1 and gamma2.
4481 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4482 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4483 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4484 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4486 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4487 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4488 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4489 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4491 if (theta(i).gt.pi-delta) then
4492 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4494 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4495 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4496 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4498 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4500 else if (theta(i).lt.delta) then
4501 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4502 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4503 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4505 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4506 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4509 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4512 etheta=etheta+ethetai
4513 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4515 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4516 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4517 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4519 C Ufff.... We've done all this!!!
4522 C---------------------------------------------------------------------------
4523 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4525 implicit real*8 (a-h,o-z)
4526 include 'DIMENSIONS'
4527 include 'COMMON.LOCAL'
4528 include 'COMMON.IOUNITS'
4529 common /calcthet/ term1,term2,termm,diffak,ratak,
4530 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4531 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4532 C Calculate the contributions to both Gaussian lobes.
4533 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4534 C The "polynomial part" of the "standard deviation" of this part of
4538 sig=sig*thet_pred_mean+polthet(j,it)
4540 C Derivative of the "interior part" of the "standard deviation of the"
4541 C gamma-dependent Gaussian lobe in t_c.
4542 sigtc=3*polthet(3,it)
4544 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4547 C Set the parameters of both Gaussian lobes of the distribution.
4548 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4549 fac=sig*sig+sigc0(it)
4552 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4553 sigsqtc=-4.0D0*sigcsq*sigtc
4554 c print *,i,sig,sigtc,sigsqtc
4555 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4556 sigtc=-sigtc/(fac*fac)
4557 C Following variable is sigma(t_c)**(-2)
4558 sigcsq=sigcsq*sigcsq
4560 sig0inv=1.0D0/sig0i**2
4561 delthec=thetai-thet_pred_mean
4562 delthe0=thetai-theta0i
4563 term1=-0.5D0*sigcsq*delthec*delthec
4564 term2=-0.5D0*sig0inv*delthe0*delthe0
4565 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4566 C NaNs in taking the logarithm. We extract the largest exponent which is added
4567 C to the energy (this being the log of the distribution) at the end of energy
4568 C term evaluation for this virtual-bond angle.
4569 if (term1.gt.term2) then
4571 term2=dexp(term2-termm)
4575 term1=dexp(term1-termm)
4578 C The ratio between the gamma-independent and gamma-dependent lobes of
4579 C the distribution is a Gaussian function of thet_pred_mean too.
4580 diffak=gthet(2,it)-thet_pred_mean
4581 ratak=diffak/gthet(3,it)**2
4582 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4583 C Let's differentiate it in thet_pred_mean NOW.
4585 C Now put together the distribution terms to make complete distribution.
4586 termexp=term1+ak*term2
4587 termpre=sigc+ak*sig0i
4588 C Contribution of the bending energy from this theta is just the -log of
4589 C the sum of the contributions from the two lobes and the pre-exponential
4590 C factor. Simple enough, isn't it?
4591 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4592 C NOW the derivatives!!!
4593 C 6/6/97 Take into account the deformation.
4594 E_theta=(delthec*sigcsq*term1
4595 & +ak*delthe0*sig0inv*term2)/termexp
4596 E_tc=((sigtc+aktc*sig0i)/termpre
4597 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4598 & aktc*term2)/termexp)
4601 c-----------------------------------------------------------------------------
4602 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4603 implicit real*8 (a-h,o-z)
4604 include 'DIMENSIONS'
4605 include 'COMMON.LOCAL'
4606 include 'COMMON.IOUNITS'
4607 common /calcthet/ term1,term2,termm,diffak,ratak,
4608 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4609 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4610 delthec=thetai-thet_pred_mean
4611 delthe0=thetai-theta0i
4612 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4613 t3 = thetai-thet_pred_mean
4617 t14 = t12+t6*sigsqtc
4619 t21 = thetai-theta0i
4625 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4626 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4627 & *(-t12*t9-ak*sig0inv*t27)
4631 C--------------------------------------------------------------------------
4632 subroutine ebend(etheta)
4634 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4635 C angles gamma and its derivatives in consecutive thetas and gammas.
4636 C ab initio-derived potentials from
4637 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4639 implicit real*8 (a-h,o-z)
4640 include 'DIMENSIONS'
4641 include 'COMMON.LOCAL'
4642 include 'COMMON.GEO'
4643 include 'COMMON.INTERACT'
4644 include 'COMMON.DERIV'
4645 include 'COMMON.VAR'
4646 include 'COMMON.CHAIN'
4647 include 'COMMON.IOUNITS'
4648 include 'COMMON.NAMES'
4649 include 'COMMON.FFIELD'
4650 include 'COMMON.CONTROL'
4651 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4652 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4653 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4654 & sinph1ph2(maxdouble,maxdouble)
4655 logical lprn /.false./, lprn1 /.false./
4657 do i=ithet_start,ithet_end
4658 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4659 &(itype(i).eq.ntyp1)) cycle
4660 C print *,i,theta(i)
4661 if (iabs(itype(i+1)).eq.20) iblock=2
4662 if (iabs(itype(i+1)).ne.20) iblock=1
4666 theti2=0.5d0*theta(i)
4667 ityp2=ithetyp((itype(i-1)))
4669 coskt(k)=dcos(k*theti2)
4670 sinkt(k)=dsin(k*theti2)
4674 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4677 if (phii.ne.phii) phii=150.0
4681 ityp1=ithetyp((itype(i-2)))
4682 C propagation of chirality for glycine type
4684 cosph1(k)=dcos(k*phii)
4685 sinph1(k)=dsin(k*phii)
4690 ityp1=ithetyp((itype(i-2)))
4695 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4698 if (phii1.ne.phii1) phii1=150.0
4703 ityp3=ithetyp((itype(i)))
4705 cosph2(k)=dcos(k*phii1)
4706 sinph2(k)=dsin(k*phii1)
4710 ityp3=ithetyp((itype(i)))
4716 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4719 ccl=cosph1(l)*cosph2(k-l)
4720 ssl=sinph1(l)*sinph2(k-l)
4721 scl=sinph1(l)*cosph2(k-l)
4722 csl=cosph1(l)*sinph2(k-l)
4723 cosph1ph2(l,k)=ccl-ssl
4724 cosph1ph2(k,l)=ccl+ssl
4725 sinph1ph2(l,k)=scl+csl
4726 sinph1ph2(k,l)=scl-csl
4730 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4731 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4732 write (iout,*) "coskt and sinkt"
4734 write (iout,*) k,coskt(k),sinkt(k)
4738 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4739 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4742 & write (iout,*) "k",k,"
4743 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4744 & " ethetai",ethetai
4747 write (iout,*) "cosph and sinph"
4749 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4751 write (iout,*) "cosph1ph2 and sinph2ph2"
4754 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4755 & sinph1ph2(l,k),sinph1ph2(k,l)
4758 write(iout,*) "ethetai",ethetai
4763 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4764 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4765 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4766 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4767 ethetai=ethetai+sinkt(m)*aux
4768 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4769 dephii=dephii+k*sinkt(m)*(
4770 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4771 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4772 dephii1=dephii1+k*sinkt(m)*(
4773 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4774 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4776 & write (iout,*) "m",m," k",k," bbthet",
4777 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4778 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4779 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4780 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4781 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4784 C print *,"cosph1", (cosph1(k), k=1,nsingle)
4785 C print *,"cosph2", (cosph2(k), k=1,nsingle)
4786 C print *,"sinph1", (sinph1(k), k=1,nsingle)
4787 C print *,"sinph2", (sinph2(k), k=1,nsingle)
4789 & write(iout,*) "ethetai",ethetai
4790 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4794 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4795 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4796 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4797 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4798 ethetai=ethetai+sinkt(m)*aux
4799 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4800 dephii=dephii+l*sinkt(m)*(
4801 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4802 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4803 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4804 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4805 dephii1=dephii1+(k-l)*sinkt(m)*(
4806 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4807 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4808 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4809 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4811 write (iout,*) "m",m," k",k," l",l," ffthet",
4812 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4813 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4814 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4815 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4816 & " ethetai",ethetai
4817 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4818 & cosph1ph2(k,l)*sinkt(m),
4819 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4828 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4829 & i,theta(i)*rad2deg,phii*rad2deg,
4830 & phii1*rad2deg,ethetai
4832 etheta=etheta+ethetai
4833 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4834 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4835 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4841 c-----------------------------------------------------------------------------
4842 subroutine esc(escloc)
4843 C Calculate the local energy of a side chain and its derivatives in the
4844 C corresponding virtual-bond valence angles THETA and the spherical angles
4846 implicit real*8 (a-h,o-z)
4847 include 'DIMENSIONS'
4848 include 'COMMON.GEO'
4849 include 'COMMON.LOCAL'
4850 include 'COMMON.VAR'
4851 include 'COMMON.INTERACT'
4852 include 'COMMON.DERIV'
4853 include 'COMMON.CHAIN'
4854 include 'COMMON.IOUNITS'
4855 include 'COMMON.NAMES'
4856 include 'COMMON.FFIELD'
4857 include 'COMMON.CONTROL'
4858 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4859 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4860 common /sccalc/ time11,time12,time112,theti,it,nlobit
4863 c write (iout,'(a)') 'ESC'
4864 do i=loc_start,loc_end
4866 if (it.eq.ntyp1) cycle
4867 if (it.eq.10) goto 1
4868 nlobit=nlob(iabs(it))
4869 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4870 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4871 theti=theta(i+1)-pipol
4876 if (x(2).gt.pi-delta) then
4880 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4882 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4883 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4885 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4886 & ddersc0(1),dersc(1))
4887 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4888 & ddersc0(3),dersc(3))
4890 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4892 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4893 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4894 & dersc0(2),esclocbi,dersc02)
4895 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4897 call splinthet(x(2),0.5d0*delta,ss,ssd)
4902 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4904 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4905 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4907 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4909 c write (iout,*) escloci
4910 else if (x(2).lt.delta) then
4914 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4916 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4917 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4919 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4920 & ddersc0(1),dersc(1))
4921 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4922 & ddersc0(3),dersc(3))
4924 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4926 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4927 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4928 & dersc0(2),esclocbi,dersc02)
4929 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4934 call splinthet(x(2),0.5d0*delta,ss,ssd)
4936 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4938 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4939 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4941 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4942 c write (iout,*) escloci
4944 call enesc(x,escloci,dersc,ddummy,.false.)
4947 escloc=escloc+escloci
4948 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4949 & 'escloc',i,escloci
4950 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4952 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4954 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4955 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4960 C---------------------------------------------------------------------------
4961 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4962 implicit real*8 (a-h,o-z)
4963 include 'DIMENSIONS'
4964 include 'COMMON.GEO'
4965 include 'COMMON.LOCAL'
4966 include 'COMMON.IOUNITS'
4967 common /sccalc/ time11,time12,time112,theti,it,nlobit
4968 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4969 double precision contr(maxlob,-1:1)
4971 c write (iout,*) 'it=',it,' nlobit=',nlobit
4975 if (mixed) ddersc(j)=0.0d0
4979 C Because of periodicity of the dependence of the SC energy in omega we have
4980 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4981 C To avoid underflows, first compute & store the exponents.
4989 z(k)=x(k)-censc(k,j,it)
4994 Axk=Axk+gaussc(l,k,j,it)*z(l)
5000 expfac=expfac+Ax(k,j,iii)*z(k)
5008 C As in the case of ebend, we want to avoid underflows in exponentiation and
5009 C subsequent NaNs and INFs in energy calculation.
5010 C Find the largest exponent
5014 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5018 cd print *,'it=',it,' emin=',emin
5020 C Compute the contribution to SC energy and derivatives
5025 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5026 if(adexp.ne.adexp) adexp=1.0
5029 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5031 cd print *,'j=',j,' expfac=',expfac
5032 escloc_i=escloc_i+expfac
5034 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5038 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5039 & +gaussc(k,2,j,it))*expfac
5046 dersc(1)=dersc(1)/cos(theti)**2
5047 ddersc(1)=ddersc(1)/cos(theti)**2
5050 escloci=-(dlog(escloc_i)-emin)
5052 dersc(j)=dersc(j)/escloc_i
5056 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5061 C------------------------------------------------------------------------------
5062 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5063 implicit real*8 (a-h,o-z)
5064 include 'DIMENSIONS'
5065 include 'COMMON.GEO'
5066 include 'COMMON.LOCAL'
5067 include 'COMMON.IOUNITS'
5068 common /sccalc/ time11,time12,time112,theti,it,nlobit
5069 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5070 double precision contr(maxlob)
5081 z(k)=x(k)-censc(k,j,it)
5087 Axk=Axk+gaussc(l,k,j,it)*z(l)
5093 expfac=expfac+Ax(k,j)*z(k)
5098 C As in the case of ebend, we want to avoid underflows in exponentiation and
5099 C subsequent NaNs and INFs in energy calculation.
5100 C Find the largest exponent
5103 if (emin.gt.contr(j)) emin=contr(j)
5107 C Compute the contribution to SC energy and derivatives
5111 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5112 escloc_i=escloc_i+expfac
5114 dersc(k)=dersc(k)+Ax(k,j)*expfac
5116 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5117 & +gaussc(1,2,j,it))*expfac
5121 dersc(1)=dersc(1)/cos(theti)**2
5122 dersc12=dersc12/cos(theti)**2
5123 escloci=-(dlog(escloc_i)-emin)
5125 dersc(j)=dersc(j)/escloc_i
5127 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5131 c----------------------------------------------------------------------------------
5132 subroutine esc(escloc)
5133 C Calculate the local energy of a side chain and its derivatives in the
5134 C corresponding virtual-bond valence angles THETA and the spherical angles
5135 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5136 C added by Urszula Kozlowska. 07/11/2007
5138 implicit real*8 (a-h,o-z)
5139 include 'DIMENSIONS'
5140 include 'COMMON.GEO'
5141 include 'COMMON.LOCAL'
5142 include 'COMMON.VAR'
5143 include 'COMMON.SCROT'
5144 include 'COMMON.INTERACT'
5145 include 'COMMON.DERIV'
5146 include 'COMMON.CHAIN'
5147 include 'COMMON.IOUNITS'
5148 include 'COMMON.NAMES'
5149 include 'COMMON.FFIELD'
5150 include 'COMMON.CONTROL'
5151 include 'COMMON.VECTORS'
5152 double precision x_prime(3),y_prime(3),z_prime(3)
5153 & , sumene,dsc_i,dp2_i,x(65),
5154 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5155 & de_dxx,de_dyy,de_dzz,de_dt
5156 double precision s1_t,s1_6_t,s2_t,s2_6_t
5158 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5159 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5160 & dt_dCi(3),dt_dCi1(3)
5161 common /sccalc/ time11,time12,time112,theti,it,nlobit
5164 do i=loc_start,loc_end
5165 if (itype(i).eq.ntyp1) cycle
5166 costtab(i+1) =dcos(theta(i+1))
5167 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5168 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5169 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5170 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5171 cosfac=dsqrt(cosfac2)
5172 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5173 sinfac=dsqrt(sinfac2)
5175 if (it.eq.10) goto 1
5177 C Compute the axes of tghe local cartesian coordinates system; store in
5178 c x_prime, y_prime and z_prime
5185 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5186 C & dc_norm(3,i+nres)
5188 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5189 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5192 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5195 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5196 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5197 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5198 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5199 c & " xy",scalar(x_prime(1),y_prime(1)),
5200 c & " xz",scalar(x_prime(1),z_prime(1)),
5201 c & " yy",scalar(y_prime(1),y_prime(1)),
5202 c & " yz",scalar(y_prime(1),z_prime(1)),
5203 c & " zz",scalar(z_prime(1),z_prime(1))
5205 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5206 C to local coordinate system. Store in xx, yy, zz.
5212 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5213 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5214 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5221 C Compute the energy of the ith side cbain
5223 c write (2,*) "xx",xx," yy",yy," zz",zz
5226 x(j) = sc_parmin(j,it)
5229 Cc diagnostics - remove later
5231 yy1 = dsin(alph(2))*dcos(omeg(2))
5232 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5233 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5234 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5236 C," --- ", xx_w,yy_w,zz_w
5239 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5240 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5242 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5243 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5245 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5246 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5247 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5248 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5249 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5251 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5252 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5253 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5254 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5255 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5257 dsc_i = 0.743d0+x(61)
5259 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5260 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5261 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5262 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5263 s1=(1+x(63))/(0.1d0 + dscp1)
5264 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5265 s2=(1+x(65))/(0.1d0 + dscp2)
5266 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5267 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5268 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5269 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5271 c & dscp1,dscp2,sumene
5272 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5273 escloc = escloc + sumene
5274 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5279 C This section to check the numerical derivatives of the energy of ith side
5280 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5281 C #define DEBUG in the code to turn it on.
5283 write (2,*) "sumene =",sumene
5287 write (2,*) xx,yy,zz
5288 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5289 de_dxx_num=(sumenep-sumene)/aincr
5291 write (2,*) "xx+ sumene from enesc=",sumenep
5294 write (2,*) xx,yy,zz
5295 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5296 de_dyy_num=(sumenep-sumene)/aincr
5298 write (2,*) "yy+ sumene from enesc=",sumenep
5301 write (2,*) xx,yy,zz
5302 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5303 de_dzz_num=(sumenep-sumene)/aincr
5305 write (2,*) "zz+ sumene from enesc=",sumenep
5306 costsave=cost2tab(i+1)
5307 sintsave=sint2tab(i+1)
5308 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5309 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5310 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5311 de_dt_num=(sumenep-sumene)/aincr
5312 write (2,*) " t+ sumene from enesc=",sumenep
5313 cost2tab(i+1)=costsave
5314 sint2tab(i+1)=sintsave
5315 C End of diagnostics section.
5318 C Compute the gradient of esc
5320 c zz=zz*dsign(1.0,dfloat(itype(i)))
5321 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5322 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5323 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5324 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5325 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5326 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5327 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5328 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5329 pom1=(sumene3*sint2tab(i+1)+sumene1)
5330 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5331 pom2=(sumene4*cost2tab(i+1)+sumene2)
5332 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5333 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5334 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5335 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5337 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5338 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5339 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5341 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5342 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5343 & +(pom1+pom2)*pom_dx
5345 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5348 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5349 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5350 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5352 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5353 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5354 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5355 & +x(59)*zz**2 +x(60)*xx*zz
5356 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5357 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5358 & +(pom1-pom2)*pom_dy
5360 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5363 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5364 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5365 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5366 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5367 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5368 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5369 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5370 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5372 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5375 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5376 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5377 & +pom1*pom_dt1+pom2*pom_dt2
5379 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5384 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5385 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5386 cosfac2xx=cosfac2*xx
5387 sinfac2yy=sinfac2*yy
5389 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5391 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5393 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5394 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5395 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5396 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5397 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5398 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5399 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5400 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5401 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5402 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5406 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5407 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5408 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5409 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5412 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5413 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5414 dZZ_XYZ(k)=vbld_inv(i+nres)*
5415 & (z_prime(k)-zz*dC_norm(k,i+nres))
5417 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5418 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5422 dXX_Ctab(k,i)=dXX_Ci(k)
5423 dXX_C1tab(k,i)=dXX_Ci1(k)
5424 dYY_Ctab(k,i)=dYY_Ci(k)
5425 dYY_C1tab(k,i)=dYY_Ci1(k)
5426 dZZ_Ctab(k,i)=dZZ_Ci(k)
5427 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5428 dXX_XYZtab(k,i)=dXX_XYZ(k)
5429 dYY_XYZtab(k,i)=dYY_XYZ(k)
5430 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5434 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5435 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5436 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5437 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5438 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5440 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5441 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5442 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5443 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5444 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5445 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5446 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5447 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5449 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5450 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5452 C to check gradient call subroutine check_grad
5458 c------------------------------------------------------------------------------
5459 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5461 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5462 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5463 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5464 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5466 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5467 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5469 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5470 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5471 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5472 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5473 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5475 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5476 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5477 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5478 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5479 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5481 dsc_i = 0.743d0+x(61)
5483 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5484 & *(xx*cost2+yy*sint2))
5485 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5486 & *(xx*cost2-yy*sint2))
5487 s1=(1+x(63))/(0.1d0 + dscp1)
5488 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5489 s2=(1+x(65))/(0.1d0 + dscp2)
5490 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5491 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5492 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5497 c------------------------------------------------------------------------------
5498 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5500 C This procedure calculates two-body contact function g(rij) and its derivative:
5503 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5506 C where x=(rij-r0ij)/delta
5508 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5511 double precision rij,r0ij,eps0ij,fcont,fprimcont
5512 double precision x,x2,x4,delta
5516 if (x.lt.-1.0D0) then
5519 else if (x.le.1.0D0) then
5522 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5523 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5530 c------------------------------------------------------------------------------
5531 subroutine splinthet(theti,delta,ss,ssder)
5532 implicit real*8 (a-h,o-z)
5533 include 'DIMENSIONS'
5534 include 'COMMON.VAR'
5535 include 'COMMON.GEO'
5538 if (theti.gt.pipol) then
5539 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5541 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5546 c------------------------------------------------------------------------------
5547 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5549 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5550 double precision ksi,ksi2,ksi3,a1,a2,a3
5551 a1=fprim0*delta/(f1-f0)
5557 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5558 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5561 c------------------------------------------------------------------------------
5562 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5564 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5565 double precision ksi,ksi2,ksi3,a1,a2,a3
5570 a2=3*(f1x-f0x)-2*fprim0x*delta
5571 a3=fprim0x*delta-2*(f1x-f0x)
5572 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5575 C-----------------------------------------------------------------------------
5577 C-----------------------------------------------------------------------------
5578 subroutine etor(etors,edihcnstr)
5579 implicit real*8 (a-h,o-z)
5580 include 'DIMENSIONS'
5581 include 'COMMON.VAR'
5582 include 'COMMON.GEO'
5583 include 'COMMON.LOCAL'
5584 include 'COMMON.TORSION'
5585 include 'COMMON.INTERACT'
5586 include 'COMMON.DERIV'
5587 include 'COMMON.CHAIN'
5588 include 'COMMON.NAMES'
5589 include 'COMMON.IOUNITS'
5590 include 'COMMON.FFIELD'
5591 include 'COMMON.TORCNSTR'
5592 include 'COMMON.CONTROL'
5594 C Set lprn=.true. for debugging
5598 do i=iphi_start,iphi_end
5600 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5601 & .or. itype(i).eq.ntyp1) cycle
5602 itori=itortyp(itype(i-2))
5603 itori1=itortyp(itype(i-1))
5606 C Proline-Proline pair is a special case...
5607 if (itori.eq.3 .and. itori1.eq.3) then
5608 if (phii.gt.-dwapi3) then
5610 fac=1.0D0/(1.0D0-cosphi)
5611 etorsi=v1(1,3,3)*fac
5612 etorsi=etorsi+etorsi
5613 etors=etors+etorsi-v1(1,3,3)
5614 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5615 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5618 v1ij=v1(j+1,itori,itori1)
5619 v2ij=v2(j+1,itori,itori1)
5622 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5623 if (energy_dec) etors_ii=etors_ii+
5624 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5625 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5629 v1ij=v1(j,itori,itori1)
5630 v2ij=v2(j,itori,itori1)
5633 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5634 if (energy_dec) etors_ii=etors_ii+
5635 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5636 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5639 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5642 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5643 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5644 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5645 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5646 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5648 ! 6/20/98 - dihedral angle constraints
5651 itori=idih_constr(i)
5654 if (difi.gt.drange(i)) then
5656 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5657 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5658 else if (difi.lt.-drange(i)) then
5660 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5661 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5663 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5664 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5666 ! write (iout,*) 'edihcnstr',edihcnstr
5669 c------------------------------------------------------------------------------
5670 subroutine etor_d(etors_d)
5674 c----------------------------------------------------------------------------
5676 subroutine etor(etors,edihcnstr)
5677 implicit real*8 (a-h,o-z)
5678 include 'DIMENSIONS'
5679 include 'COMMON.VAR'
5680 include 'COMMON.GEO'
5681 include 'COMMON.LOCAL'
5682 include 'COMMON.TORSION'
5683 include 'COMMON.INTERACT'
5684 include 'COMMON.DERIV'
5685 include 'COMMON.CHAIN'
5686 include 'COMMON.NAMES'
5687 include 'COMMON.IOUNITS'
5688 include 'COMMON.FFIELD'
5689 include 'COMMON.TORCNSTR'
5690 include 'COMMON.CONTROL'
5692 C Set lprn=.true. for debugging
5696 do i=iphi_start,iphi_end
5697 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5698 & .or. itype(i).eq.ntyp1) cycle
5700 if (iabs(itype(i)).eq.20) then
5705 itori=itortyp(itype(i-2))
5706 itori1=itortyp(itype(i-1))
5709 C Regular cosine and sine terms
5710 do j=1,nterm(itori,itori1,iblock)
5711 v1ij=v1(j,itori,itori1,iblock)
5712 v2ij=v2(j,itori,itori1,iblock)
5715 etors=etors+v1ij*cosphi+v2ij*sinphi
5716 if (energy_dec) etors_ii=etors_ii+
5717 & v1ij*cosphi+v2ij*sinphi
5718 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5722 C E = SUM ----------------------------------- - v1
5723 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5725 cosphi=dcos(0.5d0*phii)
5726 sinphi=dsin(0.5d0*phii)
5727 do j=1,nlor(itori,itori1,iblock)
5728 vl1ij=vlor1(j,itori,itori1)
5729 vl2ij=vlor2(j,itori,itori1)
5730 vl3ij=vlor3(j,itori,itori1)
5731 pom=vl2ij*cosphi+vl3ij*sinphi
5732 pom1=1.0d0/(pom*pom+1.0d0)
5733 etors=etors+vl1ij*pom1
5734 if (energy_dec) etors_ii=etors_ii+
5737 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5739 C Subtract the constant term
5740 etors=etors-v0(itori,itori1,iblock)
5741 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5742 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5744 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5745 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5746 & (v1(j,itori,itori1,iblock),j=1,6),
5747 & (v2(j,itori,itori1,iblock),j=1,6)
5748 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5749 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5751 ! 6/20/98 - dihedral angle constraints
5753 c do i=1,ndih_constr
5754 do i=idihconstr_start,idihconstr_end
5755 itori=idih_constr(i)
5757 difi=pinorm(phii-phi0(i))
5758 if (difi.gt.drange(i)) then
5760 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5761 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5762 else if (difi.lt.-drange(i)) then
5764 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5765 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5769 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5770 cd & rad2deg*phi0(i), rad2deg*drange(i),
5771 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5773 cd write (iout,*) 'edihcnstr',edihcnstr
5776 c----------------------------------------------------------------------------
5777 subroutine etor_d(etors_d)
5778 C 6/23/01 Compute double torsional energy
5779 implicit real*8 (a-h,o-z)
5780 include 'DIMENSIONS'
5781 include 'COMMON.VAR'
5782 include 'COMMON.GEO'
5783 include 'COMMON.LOCAL'
5784 include 'COMMON.TORSION'
5785 include 'COMMON.INTERACT'
5786 include 'COMMON.DERIV'
5787 include 'COMMON.CHAIN'
5788 include 'COMMON.NAMES'
5789 include 'COMMON.IOUNITS'
5790 include 'COMMON.FFIELD'
5791 include 'COMMON.TORCNSTR'
5793 C Set lprn=.true. for debugging
5797 c write(iout,*) "a tu??"
5798 do i=iphid_start,iphid_end
5799 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5800 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5801 itori=itortyp(itype(i-2))
5802 itori1=itortyp(itype(i-1))
5803 itori2=itortyp(itype(i))
5809 if (iabs(itype(i+1)).eq.20) iblock=2
5811 C Regular cosine and sine terms
5812 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5813 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5814 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5815 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5816 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5817 cosphi1=dcos(j*phii)
5818 sinphi1=dsin(j*phii)
5819 cosphi2=dcos(j*phii1)
5820 sinphi2=dsin(j*phii1)
5821 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5822 & v2cij*cosphi2+v2sij*sinphi2
5823 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5824 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5826 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5828 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5829 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5830 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5831 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5832 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5833 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5834 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5835 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5836 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5837 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5838 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5839 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5840 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5841 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5844 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5845 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5850 c------------------------------------------------------------------------------
5851 subroutine eback_sc_corr(esccor)
5852 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5853 c conformational states; temporarily implemented as differences
5854 c between UNRES torsional potentials (dependent on three types of
5855 c residues) and the torsional potentials dependent on all 20 types
5856 c of residues computed from AM1 energy surfaces of terminally-blocked
5857 c amino-acid residues.
5858 implicit real*8 (a-h,o-z)
5859 include 'DIMENSIONS'
5860 include 'COMMON.VAR'
5861 include 'COMMON.GEO'
5862 include 'COMMON.LOCAL'
5863 include 'COMMON.TORSION'
5864 include 'COMMON.SCCOR'
5865 include 'COMMON.INTERACT'
5866 include 'COMMON.DERIV'
5867 include 'COMMON.CHAIN'
5868 include 'COMMON.NAMES'
5869 include 'COMMON.IOUNITS'
5870 include 'COMMON.FFIELD'
5871 include 'COMMON.CONTROL'
5873 C Set lprn=.true. for debugging
5876 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5878 do i=itau_start,itau_end
5879 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5881 isccori=isccortyp(itype(i-2))
5882 isccori1=isccortyp(itype(i-1))
5883 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5885 do intertyp=1,3 !intertyp
5886 cc Added 09 May 2012 (Adasko)
5887 cc Intertyp means interaction type of backbone mainchain correlation:
5888 c 1 = SC...Ca...Ca...Ca
5889 c 2 = Ca...Ca...Ca...SC
5890 c 3 = SC...Ca...Ca...SCi
5892 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5893 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5894 & (itype(i-1).eq.ntyp1)))
5895 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5896 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5897 & .or.(itype(i).eq.ntyp1)))
5898 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5899 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5900 & (itype(i-3).eq.ntyp1)))) cycle
5901 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5902 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5904 do j=1,nterm_sccor(isccori,isccori1)
5905 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5906 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5907 cosphi=dcos(j*tauangle(intertyp,i))
5908 sinphi=dsin(j*tauangle(intertyp,i))
5909 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5910 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5912 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5913 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5915 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5916 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
5917 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
5918 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5919 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5925 c----------------------------------------------------------------------------
5926 subroutine multibody(ecorr)
5927 C This subroutine calculates multi-body contributions to energy following
5928 C the idea of Skolnick et al. If side chains I and J make a contact and
5929 C at the same time side chains I+1 and J+1 make a contact, an extra
5930 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5931 implicit real*8 (a-h,o-z)
5932 include 'DIMENSIONS'
5933 include 'COMMON.IOUNITS'
5934 include 'COMMON.DERIV'
5935 include 'COMMON.INTERACT'
5936 include 'COMMON.CONTACTS'
5937 double precision gx(3),gx1(3)
5940 C Set lprn=.true. for debugging
5944 write (iout,'(a)') 'Contact function values:'
5946 write (iout,'(i2,20(1x,i2,f10.5))')
5947 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5962 num_conti=num_cont(i)
5963 num_conti1=num_cont(i1)
5968 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5969 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5970 cd & ' ishift=',ishift
5971 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5972 C The system gains extra energy.
5973 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5974 endif ! j1==j+-ishift
5983 c------------------------------------------------------------------------------
5984 double precision function esccorr(i,j,k,l,jj,kk)
5985 implicit real*8 (a-h,o-z)
5986 include 'DIMENSIONS'
5987 include 'COMMON.IOUNITS'
5988 include 'COMMON.DERIV'
5989 include 'COMMON.INTERACT'
5990 include 'COMMON.CONTACTS'
5991 double precision gx(3),gx1(3)
5996 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5997 C Calculate the multi-body contribution to energy.
5998 C Calculate multi-body contributions to the gradient.
5999 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6000 cd & k,l,(gacont(m,kk,k),m=1,3)
6002 gx(m) =ekl*gacont(m,jj,i)
6003 gx1(m)=eij*gacont(m,kk,k)
6004 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6005 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6006 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6007 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6011 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6016 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6022 c------------------------------------------------------------------------------
6023 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6024 C This subroutine calculates multi-body contributions to hydrogen-bonding
6025 implicit real*8 (a-h,o-z)
6026 include 'DIMENSIONS'
6027 include 'COMMON.IOUNITS'
6030 parameter (max_cont=maxconts)
6031 parameter (max_dim=26)
6032 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6033 double precision zapas(max_dim,maxconts,max_fg_procs),
6034 & zapas_recv(max_dim,maxconts,max_fg_procs)
6035 common /przechowalnia/ zapas
6036 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6037 & status_array(MPI_STATUS_SIZE,maxconts*2)
6039 include 'COMMON.SETUP'
6040 include 'COMMON.FFIELD'
6041 include 'COMMON.DERIV'
6042 include 'COMMON.INTERACT'
6043 include 'COMMON.CONTACTS'
6044 include 'COMMON.CONTROL'
6045 include 'COMMON.LOCAL'
6046 double precision gx(3),gx1(3),time00
6049 C Set lprn=.true. for debugging
6054 if (nfgtasks.le.1) goto 30
6056 write (iout,'(a)') 'Contact function values before RECEIVE:'
6058 write (iout,'(2i3,50(1x,i2,f5.2))')
6059 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6060 & j=1,num_cont_hb(i))
6064 do i=1,ntask_cont_from
6067 do i=1,ntask_cont_to
6070 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6072 C Make the list of contacts to send to send to other procesors
6073 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6075 do i=iturn3_start,iturn3_end
6076 c write (iout,*) "make contact list turn3",i," num_cont",
6078 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6080 do i=iturn4_start,iturn4_end
6081 c write (iout,*) "make contact list turn4",i," num_cont",
6083 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6087 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6089 do j=1,num_cont_hb(i)
6092 iproc=iint_sent_local(k,jjc,ii)
6093 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6094 if (iproc.gt.0) then
6095 ncont_sent(iproc)=ncont_sent(iproc)+1
6096 nn=ncont_sent(iproc)
6098 zapas(2,nn,iproc)=jjc
6099 zapas(3,nn,iproc)=facont_hb(j,i)
6100 zapas(4,nn,iproc)=ees0p(j,i)
6101 zapas(5,nn,iproc)=ees0m(j,i)
6102 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6103 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6104 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6105 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6106 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6107 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6108 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6109 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6110 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6111 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6112 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6113 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6114 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6115 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6116 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6117 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6118 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6119 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6120 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6121 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6122 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6129 & "Numbers of contacts to be sent to other processors",
6130 & (ncont_sent(i),i=1,ntask_cont_to)
6131 write (iout,*) "Contacts sent"
6132 do ii=1,ntask_cont_to
6134 iproc=itask_cont_to(ii)
6135 write (iout,*) nn," contacts to processor",iproc,
6136 & " of CONT_TO_COMM group"
6138 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6146 CorrelID1=nfgtasks+fg_rank+1
6148 C Receive the numbers of needed contacts from other processors
6149 do ii=1,ntask_cont_from
6150 iproc=itask_cont_from(ii)
6152 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6153 & FG_COMM,req(ireq),IERR)
6155 c write (iout,*) "IRECV ended"
6157 C Send the number of contacts needed by other processors
6158 do ii=1,ntask_cont_to
6159 iproc=itask_cont_to(ii)
6161 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6162 & FG_COMM,req(ireq),IERR)
6164 c write (iout,*) "ISEND ended"
6165 c write (iout,*) "number of requests (nn)",ireq
6168 & call MPI_Waitall(ireq,req,status_array,ierr)
6170 c & "Numbers of contacts to be received from other processors",
6171 c & (ncont_recv(i),i=1,ntask_cont_from)
6175 do ii=1,ntask_cont_from
6176 iproc=itask_cont_from(ii)
6178 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6179 c & " of CONT_TO_COMM group"
6183 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6184 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6185 c write (iout,*) "ireq,req",ireq,req(ireq)
6188 C Send the contacts to processors that need them
6189 do ii=1,ntask_cont_to
6190 iproc=itask_cont_to(ii)
6192 c write (iout,*) nn," contacts to processor",iproc,
6193 c & " of CONT_TO_COMM group"
6196 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6197 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6198 c write (iout,*) "ireq,req",ireq,req(ireq)
6200 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6204 c write (iout,*) "number of requests (contacts)",ireq
6205 c write (iout,*) "req",(req(i),i=1,4)
6208 & call MPI_Waitall(ireq,req,status_array,ierr)
6209 do iii=1,ntask_cont_from
6210 iproc=itask_cont_from(iii)
6213 write (iout,*) "Received",nn," contacts from processor",iproc,
6214 & " of CONT_FROM_COMM group"
6217 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6222 ii=zapas_recv(1,i,iii)
6223 c Flag the received contacts to prevent double-counting
6224 jj=-zapas_recv(2,i,iii)
6225 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6227 nnn=num_cont_hb(ii)+1
6230 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6231 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6232 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6233 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6234 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6235 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6236 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6237 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6238 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6239 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6240 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6241 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6242 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6243 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6244 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6245 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6246 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6247 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6248 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6249 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6250 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6251 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6252 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6253 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6258 write (iout,'(a)') 'Contact function values after receive:'
6260 write (iout,'(2i3,50(1x,i3,f5.2))')
6261 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6262 & j=1,num_cont_hb(i))
6269 write (iout,'(a)') 'Contact function values:'
6271 write (iout,'(2i3,50(1x,i3,f5.2))')
6272 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6273 & j=1,num_cont_hb(i))
6277 C Remove the loop below after debugging !!!
6284 C Calculate the local-electrostatic correlation terms
6285 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6287 num_conti=num_cont_hb(i)
6288 num_conti1=num_cont_hb(i+1)
6295 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6296 c & ' jj=',jj,' kk=',kk
6297 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6298 & .or. j.lt.0 .and. j1.gt.0) .and.
6299 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6300 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6301 C The system gains extra energy.
6302 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6303 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6304 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6306 else if (j1.eq.j) then
6307 C Contacts I-J and I-(J+1) occur simultaneously.
6308 C The system loses extra energy.
6309 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6314 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6315 c & ' jj=',jj,' kk=',kk
6317 C Contacts I-J and (I+1)-J occur simultaneously.
6318 C The system loses extra energy.
6319 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6326 c------------------------------------------------------------------------------
6327 subroutine add_hb_contact(ii,jj,itask)
6328 implicit real*8 (a-h,o-z)
6329 include "DIMENSIONS"
6330 include "COMMON.IOUNITS"
6333 parameter (max_cont=maxconts)
6334 parameter (max_dim=26)
6335 include "COMMON.CONTACTS"
6336 double precision zapas(max_dim,maxconts,max_fg_procs),
6337 & zapas_recv(max_dim,maxconts,max_fg_procs)
6338 common /przechowalnia/ zapas
6339 integer i,j,ii,jj,iproc,itask(4),nn
6340 c write (iout,*) "itask",itask
6343 if (iproc.gt.0) then
6344 do j=1,num_cont_hb(ii)
6346 c write (iout,*) "i",ii," j",jj," jjc",jjc
6348 ncont_sent(iproc)=ncont_sent(iproc)+1
6349 nn=ncont_sent(iproc)
6350 zapas(1,nn,iproc)=ii
6351 zapas(2,nn,iproc)=jjc
6352 zapas(3,nn,iproc)=facont_hb(j,ii)
6353 zapas(4,nn,iproc)=ees0p(j,ii)
6354 zapas(5,nn,iproc)=ees0m(j,ii)
6355 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6356 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6357 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6358 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6359 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6360 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6361 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6362 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6363 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6364 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6365 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6366 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6367 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6368 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6369 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6370 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6371 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6372 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6373 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6374 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6375 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6383 c------------------------------------------------------------------------------
6384 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6386 C This subroutine calculates multi-body contributions to hydrogen-bonding
6387 implicit real*8 (a-h,o-z)
6388 include 'DIMENSIONS'
6389 include 'COMMON.IOUNITS'
6392 parameter (max_cont=maxconts)
6393 parameter (max_dim=70)
6394 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6395 double precision zapas(max_dim,maxconts,max_fg_procs),
6396 & zapas_recv(max_dim,maxconts,max_fg_procs)
6397 common /przechowalnia/ zapas
6398 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6399 & status_array(MPI_STATUS_SIZE,maxconts*2)
6401 include 'COMMON.SETUP'
6402 include 'COMMON.FFIELD'
6403 include 'COMMON.DERIV'
6404 include 'COMMON.LOCAL'
6405 include 'COMMON.INTERACT'
6406 include 'COMMON.CONTACTS'
6407 include 'COMMON.CHAIN'
6408 include 'COMMON.CONTROL'
6409 double precision gx(3),gx1(3)
6410 integer num_cont_hb_old(maxres)
6412 double precision eello4,eello5,eelo6,eello_turn6
6413 external eello4,eello5,eello6,eello_turn6
6414 C Set lprn=.true. for debugging
6419 num_cont_hb_old(i)=num_cont_hb(i)
6423 if (nfgtasks.le.1) goto 30
6425 write (iout,'(a)') 'Contact function values before RECEIVE:'
6427 write (iout,'(2i3,50(1x,i2,f5.2))')
6428 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6429 & j=1,num_cont_hb(i))
6433 do i=1,ntask_cont_from
6436 do i=1,ntask_cont_to
6439 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6441 C Make the list of contacts to send to send to other procesors
6442 do i=iturn3_start,iturn3_end
6443 c write (iout,*) "make contact list turn3",i," num_cont",
6445 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6447 do i=iturn4_start,iturn4_end
6448 c write (iout,*) "make contact list turn4",i," num_cont",
6450 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6454 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6456 do j=1,num_cont_hb(i)
6459 iproc=iint_sent_local(k,jjc,ii)
6460 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6461 if (iproc.ne.0) then
6462 ncont_sent(iproc)=ncont_sent(iproc)+1
6463 nn=ncont_sent(iproc)
6465 zapas(2,nn,iproc)=jjc
6466 zapas(3,nn,iproc)=d_cont(j,i)
6470 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6475 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6483 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6494 & "Numbers of contacts to be sent to other processors",
6495 & (ncont_sent(i),i=1,ntask_cont_to)
6496 write (iout,*) "Contacts sent"
6497 do ii=1,ntask_cont_to
6499 iproc=itask_cont_to(ii)
6500 write (iout,*) nn," contacts to processor",iproc,
6501 & " of CONT_TO_COMM group"
6503 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6511 CorrelID1=nfgtasks+fg_rank+1
6513 C Receive the numbers of needed contacts from other processors
6514 do ii=1,ntask_cont_from
6515 iproc=itask_cont_from(ii)
6517 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6518 & FG_COMM,req(ireq),IERR)
6520 c write (iout,*) "IRECV ended"
6522 C Send the number of contacts needed by other processors
6523 do ii=1,ntask_cont_to
6524 iproc=itask_cont_to(ii)
6526 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6527 & FG_COMM,req(ireq),IERR)
6529 c write (iout,*) "ISEND ended"
6530 c write (iout,*) "number of requests (nn)",ireq
6533 & call MPI_Waitall(ireq,req,status_array,ierr)
6535 c & "Numbers of contacts to be received from other processors",
6536 c & (ncont_recv(i),i=1,ntask_cont_from)
6540 do ii=1,ntask_cont_from
6541 iproc=itask_cont_from(ii)
6543 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6544 c & " of CONT_TO_COMM group"
6548 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6549 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6550 c write (iout,*) "ireq,req",ireq,req(ireq)
6553 C Send the contacts to processors that need them
6554 do ii=1,ntask_cont_to
6555 iproc=itask_cont_to(ii)
6557 c write (iout,*) nn," contacts to processor",iproc,
6558 c & " of CONT_TO_COMM group"
6561 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6562 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6563 c write (iout,*) "ireq,req",ireq,req(ireq)
6565 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6569 c write (iout,*) "number of requests (contacts)",ireq
6570 c write (iout,*) "req",(req(i),i=1,4)
6573 & call MPI_Waitall(ireq,req,status_array,ierr)
6574 do iii=1,ntask_cont_from
6575 iproc=itask_cont_from(iii)
6578 write (iout,*) "Received",nn," contacts from processor",iproc,
6579 & " of CONT_FROM_COMM group"
6582 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6587 ii=zapas_recv(1,i,iii)
6588 c Flag the received contacts to prevent double-counting
6589 jj=-zapas_recv(2,i,iii)
6590 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6592 nnn=num_cont_hb(ii)+1
6595 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6599 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6604 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6612 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6621 write (iout,'(a)') 'Contact function values after receive:'
6623 write (iout,'(2i3,50(1x,i3,5f6.3))')
6624 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6625 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6632 write (iout,'(a)') 'Contact function values:'
6634 write (iout,'(2i3,50(1x,i2,5f6.3))')
6635 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6636 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6642 C Remove the loop below after debugging !!!
6649 C Calculate the dipole-dipole interaction energies
6650 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6651 do i=iatel_s,iatel_e+1
6652 num_conti=num_cont_hb(i)
6661 C Calculate the local-electrostatic correlation terms
6662 c write (iout,*) "gradcorr5 in eello5 before loop"
6664 c write (iout,'(i5,3f10.5)')
6665 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6667 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6668 c write (iout,*) "corr loop i",i
6670 num_conti=num_cont_hb(i)
6671 num_conti1=num_cont_hb(i+1)
6678 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6679 c & ' jj=',jj,' kk=',kk
6680 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6681 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6682 & .or. j.lt.0 .and. j1.gt.0) .and.
6683 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6684 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6685 C The system gains extra energy.
6687 sqd1=dsqrt(d_cont(jj,i))
6688 sqd2=dsqrt(d_cont(kk,i1))
6689 sred_geom = sqd1*sqd2
6690 IF (sred_geom.lt.cutoff_corr) THEN
6691 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6693 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6694 cd & ' jj=',jj,' kk=',kk
6695 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6696 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6698 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6699 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6702 cd write (iout,*) 'sred_geom=',sred_geom,
6703 cd & ' ekont=',ekont,' fprim=',fprimcont,
6704 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6705 cd write (iout,*) "g_contij",g_contij
6706 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6707 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6708 call calc_eello(i,jp,i+1,jp1,jj,kk)
6709 if (wcorr4.gt.0.0d0)
6710 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6711 if (energy_dec.and.wcorr4.gt.0.0d0)
6712 1 write (iout,'(a6,4i5,0pf7.3)')
6713 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6714 c write (iout,*) "gradcorr5 before eello5"
6716 c write (iout,'(i5,3f10.5)')
6717 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6719 if (wcorr5.gt.0.0d0)
6720 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6721 c write (iout,*) "gradcorr5 after eello5"
6723 c write (iout,'(i5,3f10.5)')
6724 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6726 if (energy_dec.and.wcorr5.gt.0.0d0)
6727 1 write (iout,'(a6,4i5,0pf7.3)')
6728 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6729 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6730 cd write(2,*)'ijkl',i,jp,i+1,jp1
6731 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6732 & .or. wturn6.eq.0.0d0))then
6733 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6734 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6735 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6736 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6737 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6738 cd & 'ecorr6=',ecorr6
6739 cd write (iout,'(4e15.5)') sred_geom,
6740 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6741 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6742 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6743 else if (wturn6.gt.0.0d0
6744 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6745 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6746 eturn6=eturn6+eello_turn6(i,jj,kk)
6747 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6748 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6749 cd write (2,*) 'multibody_eello:eturn6',eturn6
6758 num_cont_hb(i)=num_cont_hb_old(i)
6760 c write (iout,*) "gradcorr5 in eello5"
6762 c write (iout,'(i5,3f10.5)')
6763 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6767 c------------------------------------------------------------------------------
6768 subroutine add_hb_contact_eello(ii,jj,itask)
6769 implicit real*8 (a-h,o-z)
6770 include "DIMENSIONS"
6771 include "COMMON.IOUNITS"
6774 parameter (max_cont=maxconts)
6775 parameter (max_dim=70)
6776 include "COMMON.CONTACTS"
6777 double precision zapas(max_dim,maxconts,max_fg_procs),
6778 & zapas_recv(max_dim,maxconts,max_fg_procs)
6779 common /przechowalnia/ zapas
6780 integer i,j,ii,jj,iproc,itask(4),nn
6781 c write (iout,*) "itask",itask
6784 if (iproc.gt.0) then
6785 do j=1,num_cont_hb(ii)
6787 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6789 ncont_sent(iproc)=ncont_sent(iproc)+1
6790 nn=ncont_sent(iproc)
6791 zapas(1,nn,iproc)=ii
6792 zapas(2,nn,iproc)=jjc
6793 zapas(3,nn,iproc)=d_cont(j,ii)
6797 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6802 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6810 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6822 c------------------------------------------------------------------------------
6823 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6824 implicit real*8 (a-h,o-z)
6825 include 'DIMENSIONS'
6826 include 'COMMON.IOUNITS'
6827 include 'COMMON.DERIV'
6828 include 'COMMON.INTERACT'
6829 include 'COMMON.CONTACTS'
6830 double precision gx(3),gx1(3)
6840 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6841 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6842 C Following 4 lines for diagnostics.
6847 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6848 c & 'Contacts ',i,j,
6849 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6850 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6852 C Calculate the multi-body contribution to energy.
6853 c ecorr=ecorr+ekont*ees
6854 C Calculate multi-body contributions to the gradient.
6855 coeffpees0pij=coeffp*ees0pij
6856 coeffmees0mij=coeffm*ees0mij
6857 coeffpees0pkl=coeffp*ees0pkl
6858 coeffmees0mkl=coeffm*ees0mkl
6860 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6861 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6862 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6863 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6864 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6865 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6866 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6867 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6868 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6869 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6870 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6871 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6872 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6873 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6874 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6875 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6876 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6877 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6878 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6879 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6880 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6881 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6882 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6883 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6884 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6889 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6890 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6891 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6892 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6897 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6898 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6899 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6900 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6903 c write (iout,*) "ehbcorr",ekont*ees
6908 C---------------------------------------------------------------------------
6909 subroutine dipole(i,j,jj)
6910 implicit real*8 (a-h,o-z)
6911 include 'DIMENSIONS'
6912 include 'COMMON.IOUNITS'
6913 include 'COMMON.CHAIN'
6914 include 'COMMON.FFIELD'
6915 include 'COMMON.DERIV'
6916 include 'COMMON.INTERACT'
6917 include 'COMMON.CONTACTS'
6918 include 'COMMON.TORSION'
6919 include 'COMMON.VAR'
6920 include 'COMMON.GEO'
6921 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6923 iti1 = itortyp(itype(i+1))
6924 if (j.lt.nres-1) then
6925 itj1 = itortyp(itype(j+1))
6930 dipi(iii,1)=Ub2(iii,i)
6931 dipderi(iii)=Ub2der(iii,i)
6932 dipi(iii,2)=b1(iii,iti1)
6933 dipj(iii,1)=Ub2(iii,j)
6934 dipderj(iii)=Ub2der(iii,j)
6935 dipj(iii,2)=b1(iii,itj1)
6939 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6942 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6949 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6953 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6958 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6959 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6961 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6963 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6965 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6970 C---------------------------------------------------------------------------
6971 subroutine calc_eello(i,j,k,l,jj,kk)
6973 C This subroutine computes matrices and vectors needed to calculate
6974 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6976 implicit real*8 (a-h,o-z)
6977 include 'DIMENSIONS'
6978 include 'COMMON.IOUNITS'
6979 include 'COMMON.CHAIN'
6980 include 'COMMON.DERIV'
6981 include 'COMMON.INTERACT'
6982 include 'COMMON.CONTACTS'
6983 include 'COMMON.TORSION'
6984 include 'COMMON.VAR'
6985 include 'COMMON.GEO'
6986 include 'COMMON.FFIELD'
6987 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6988 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6991 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6992 cd & ' jj=',jj,' kk=',kk
6993 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6994 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6995 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6998 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6999 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7002 call transpose2(aa1(1,1),aa1t(1,1))
7003 call transpose2(aa2(1,1),aa2t(1,1))
7006 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7007 & aa1tder(1,1,lll,kkk))
7008 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7009 & aa2tder(1,1,lll,kkk))
7013 C parallel orientation of the two CA-CA-CA frames.
7015 iti=itortyp(itype(i))
7019 itk1=itortyp(itype(k+1))
7020 itj=itortyp(itype(j))
7021 if (l.lt.nres-1) then
7022 itl1=itortyp(itype(l+1))
7026 C A1 kernel(j+1) A2T
7028 cd write (iout,'(3f10.5,5x,3f10.5)')
7029 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7031 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7032 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7033 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7034 C Following matrices are needed only for 6-th order cumulants
7035 IF (wcorr6.gt.0.0d0) THEN
7036 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7037 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7038 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7039 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7040 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7041 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7042 & ADtEAderx(1,1,1,1,1,1))
7044 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7045 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7046 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7047 & ADtEA1derx(1,1,1,1,1,1))
7049 C End 6-th order cumulants
7052 cd write (2,*) 'In calc_eello6'
7054 cd write (2,*) 'iii=',iii
7056 cd write (2,*) 'kkk=',kkk
7058 cd write (2,'(3(2f10.5),5x)')
7059 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7064 call transpose2(EUgder(1,1,k),auxmat(1,1))
7065 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7066 call transpose2(EUg(1,1,k),auxmat(1,1))
7067 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7068 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7072 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7073 & EAEAderx(1,1,lll,kkk,iii,1))
7077 C A1T kernel(i+1) A2
7078 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7079 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7080 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7081 C Following matrices are needed only for 6-th order cumulants
7082 IF (wcorr6.gt.0.0d0) THEN
7083 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7084 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7085 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7086 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7087 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7088 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7089 & ADtEAderx(1,1,1,1,1,2))
7090 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7091 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7092 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7093 & ADtEA1derx(1,1,1,1,1,2))
7095 C End 6-th order cumulants
7096 call transpose2(EUgder(1,1,l),auxmat(1,1))
7097 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7098 call transpose2(EUg(1,1,l),auxmat(1,1))
7099 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7100 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7104 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7105 & EAEAderx(1,1,lll,kkk,iii,2))
7110 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7111 C They are needed only when the fifth- or the sixth-order cumulants are
7113 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7114 call transpose2(AEA(1,1,1),auxmat(1,1))
7115 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7116 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7117 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7118 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7119 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7120 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7121 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7122 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7123 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7124 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7125 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7126 call transpose2(AEA(1,1,2),auxmat(1,1))
7127 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7128 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7129 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7130 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7131 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7132 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7133 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7134 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7135 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7136 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7137 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7138 C Calculate the Cartesian derivatives of the vectors.
7142 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7143 call matvec2(auxmat(1,1),b1(1,iti),
7144 & AEAb1derx(1,lll,kkk,iii,1,1))
7145 call matvec2(auxmat(1,1),Ub2(1,i),
7146 & AEAb2derx(1,lll,kkk,iii,1,1))
7147 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7148 & AEAb1derx(1,lll,kkk,iii,2,1))
7149 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7150 & AEAb2derx(1,lll,kkk,iii,2,1))
7151 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7152 call matvec2(auxmat(1,1),b1(1,itj),
7153 & AEAb1derx(1,lll,kkk,iii,1,2))
7154 call matvec2(auxmat(1,1),Ub2(1,j),
7155 & AEAb2derx(1,lll,kkk,iii,1,2))
7156 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7157 & AEAb1derx(1,lll,kkk,iii,2,2))
7158 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7159 & AEAb2derx(1,lll,kkk,iii,2,2))
7166 C Antiparallel orientation of the two CA-CA-CA frames.
7168 iti=itortyp(itype(i))
7172 itk1=itortyp(itype(k+1))
7173 itl=itortyp(itype(l))
7174 itj=itortyp(itype(j))
7175 if (j.lt.nres-1) then
7176 itj1=itortyp(itype(j+1))
7180 C A2 kernel(j-1)T A1T
7181 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7182 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7183 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7184 C Following matrices are needed only for 6-th order cumulants
7185 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7186 & j.eq.i+4 .and. l.eq.i+3)) THEN
7187 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7188 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7189 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7190 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7191 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7192 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7193 & ADtEAderx(1,1,1,1,1,1))
7194 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7195 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7196 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7197 & ADtEA1derx(1,1,1,1,1,1))
7199 C End 6-th order cumulants
7200 call transpose2(EUgder(1,1,k),auxmat(1,1))
7201 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7202 call transpose2(EUg(1,1,k),auxmat(1,1))
7203 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7204 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7208 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7209 & EAEAderx(1,1,lll,kkk,iii,1))
7213 C A2T kernel(i+1)T A1
7214 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7215 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7216 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7217 C Following matrices are needed only for 6-th order cumulants
7218 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7219 & j.eq.i+4 .and. l.eq.i+3)) THEN
7220 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7221 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7222 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7223 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7224 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7225 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7226 & ADtEAderx(1,1,1,1,1,2))
7227 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7228 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7229 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7230 & ADtEA1derx(1,1,1,1,1,2))
7232 C End 6-th order cumulants
7233 call transpose2(EUgder(1,1,j),auxmat(1,1))
7234 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7235 call transpose2(EUg(1,1,j),auxmat(1,1))
7236 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7237 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7241 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7242 & EAEAderx(1,1,lll,kkk,iii,2))
7247 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7248 C They are needed only when the fifth- or the sixth-order cumulants are
7250 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7251 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7252 call transpose2(AEA(1,1,1),auxmat(1,1))
7253 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7254 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7255 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7256 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7257 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7258 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7259 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7260 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7261 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7262 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7263 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7264 call transpose2(AEA(1,1,2),auxmat(1,1))
7265 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7266 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7267 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7268 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7269 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7270 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7271 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7272 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7273 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7274 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7275 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7276 C Calculate the Cartesian derivatives of the vectors.
7280 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7281 call matvec2(auxmat(1,1),b1(1,iti),
7282 & AEAb1derx(1,lll,kkk,iii,1,1))
7283 call matvec2(auxmat(1,1),Ub2(1,i),
7284 & AEAb2derx(1,lll,kkk,iii,1,1))
7285 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7286 & AEAb1derx(1,lll,kkk,iii,2,1))
7287 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7288 & AEAb2derx(1,lll,kkk,iii,2,1))
7289 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7290 call matvec2(auxmat(1,1),b1(1,itl),
7291 & AEAb1derx(1,lll,kkk,iii,1,2))
7292 call matvec2(auxmat(1,1),Ub2(1,l),
7293 & AEAb2derx(1,lll,kkk,iii,1,2))
7294 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7295 & AEAb1derx(1,lll,kkk,iii,2,2))
7296 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7297 & AEAb2derx(1,lll,kkk,iii,2,2))
7306 C---------------------------------------------------------------------------
7307 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7308 & KK,KKderg,AKA,AKAderg,AKAderx)
7312 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7313 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7314 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7319 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7321 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7324 cd if (lprn) write (2,*) 'In kernel'
7326 cd if (lprn) write (2,*) 'kkk=',kkk
7328 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7329 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7331 cd write (2,*) 'lll=',lll
7332 cd write (2,*) 'iii=1'
7334 cd write (2,'(3(2f10.5),5x)')
7335 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7338 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7339 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7341 cd write (2,*) 'lll=',lll
7342 cd write (2,*) 'iii=2'
7344 cd write (2,'(3(2f10.5),5x)')
7345 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7352 C---------------------------------------------------------------------------
7353 double precision function eello4(i,j,k,l,jj,kk)
7354 implicit real*8 (a-h,o-z)
7355 include 'DIMENSIONS'
7356 include 'COMMON.IOUNITS'
7357 include 'COMMON.CHAIN'
7358 include 'COMMON.DERIV'
7359 include 'COMMON.INTERACT'
7360 include 'COMMON.CONTACTS'
7361 include 'COMMON.TORSION'
7362 include 'COMMON.VAR'
7363 include 'COMMON.GEO'
7364 double precision pizda(2,2),ggg1(3),ggg2(3)
7365 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7369 cd print *,'eello4:',i,j,k,l,jj,kk
7370 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7371 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7372 cold eij=facont_hb(jj,i)
7373 cold ekl=facont_hb(kk,k)
7375 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7376 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7377 gcorr_loc(k-1)=gcorr_loc(k-1)
7378 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7380 gcorr_loc(l-1)=gcorr_loc(l-1)
7381 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7383 gcorr_loc(j-1)=gcorr_loc(j-1)
7384 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7389 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7390 & -EAEAderx(2,2,lll,kkk,iii,1)
7391 cd derx(lll,kkk,iii)=0.0d0
7395 cd gcorr_loc(l-1)=0.0d0
7396 cd gcorr_loc(j-1)=0.0d0
7397 cd gcorr_loc(k-1)=0.0d0
7399 cd write (iout,*)'Contacts have occurred for peptide groups',
7400 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7401 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7402 if (j.lt.nres-1) then
7409 if (l.lt.nres-1) then
7417 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7418 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7419 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7420 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7421 cgrad ghalf=0.5d0*ggg1(ll)
7422 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7423 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7424 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7425 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7426 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7427 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7428 cgrad ghalf=0.5d0*ggg2(ll)
7429 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7430 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7431 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7432 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7433 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7434 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7438 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7443 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7448 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7453 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7457 cd write (2,*) iii,gcorr_loc(iii)
7460 cd write (2,*) 'ekont',ekont
7461 cd write (iout,*) 'eello4',ekont*eel4
7464 C---------------------------------------------------------------------------
7465 double precision function eello5(i,j,k,l,jj,kk)
7466 implicit real*8 (a-h,o-z)
7467 include 'DIMENSIONS'
7468 include 'COMMON.IOUNITS'
7469 include 'COMMON.CHAIN'
7470 include 'COMMON.DERIV'
7471 include 'COMMON.INTERACT'
7472 include 'COMMON.CONTACTS'
7473 include 'COMMON.TORSION'
7474 include 'COMMON.VAR'
7475 include 'COMMON.GEO'
7476 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7477 double precision ggg1(3),ggg2(3)
7478 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7483 C /l\ / \ \ / \ / \ / C
7484 C / \ / \ \ / \ / \ / C
7485 C j| o |l1 | o | o| o | | o |o C
7486 C \ |/k\| |/ \| / |/ \| |/ \| C
7487 C \i/ \ / \ / / \ / \ C
7489 C (I) (II) (III) (IV) C
7491 C eello5_1 eello5_2 eello5_3 eello5_4 C
7493 C Antiparallel chains C
7496 C /j\ / \ \ / \ / \ / C
7497 C / \ / \ \ / \ / \ / C
7498 C j1| o |l | o | o| o | | o |o C
7499 C \ |/k\| |/ \| / |/ \| |/ \| C
7500 C \i/ \ / \ / / \ / \ C
7502 C (I) (II) (III) (IV) C
7504 C eello5_1 eello5_2 eello5_3 eello5_4 C
7506 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7508 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7509 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7514 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7516 itk=itortyp(itype(k))
7517 itl=itortyp(itype(l))
7518 itj=itortyp(itype(j))
7523 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7524 cd & eel5_3_num,eel5_4_num)
7528 derx(lll,kkk,iii)=0.0d0
7532 cd eij=facont_hb(jj,i)
7533 cd ekl=facont_hb(kk,k)
7535 cd write (iout,*)'Contacts have occurred for peptide groups',
7536 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7538 C Contribution from the graph I.
7539 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7540 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7541 call transpose2(EUg(1,1,k),auxmat(1,1))
7542 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7543 vv(1)=pizda(1,1)-pizda(2,2)
7544 vv(2)=pizda(1,2)+pizda(2,1)
7545 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7546 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7547 C Explicit gradient in virtual-dihedral angles.
7548 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7549 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7550 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7551 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7552 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7553 vv(1)=pizda(1,1)-pizda(2,2)
7554 vv(2)=pizda(1,2)+pizda(2,1)
7555 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7556 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7557 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7558 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7559 vv(1)=pizda(1,1)-pizda(2,2)
7560 vv(2)=pizda(1,2)+pizda(2,1)
7562 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7563 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7564 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7566 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7567 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7568 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7570 C Cartesian gradient
7574 call matmat2(AEAderx(1,1,lll,kkk,iii,1),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,1),Ub2(1,k))
7580 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7586 C Contribution from graph II
7587 call transpose2(EE(1,1,itk),auxmat(1,1))
7588 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7589 vv(1)=pizda(1,1)+pizda(2,2)
7590 vv(2)=pizda(2,1)-pizda(1,2)
7591 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7592 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7593 C Explicit gradient in virtual-dihedral angles.
7594 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7595 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7596 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7597 vv(1)=pizda(1,1)+pizda(2,2)
7598 vv(2)=pizda(2,1)-pizda(1,2)
7600 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7601 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7602 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7604 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7605 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7606 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7608 C Cartesian gradient
7612 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7614 vv(1)=pizda(1,1)+pizda(2,2)
7615 vv(2)=pizda(2,1)-pizda(1,2)
7616 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7617 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7618 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7626 C Parallel orientation
7627 C Contribution from graph III
7628 call transpose2(EUg(1,1,l),auxmat(1,1))
7629 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7630 vv(1)=pizda(1,1)-pizda(2,2)
7631 vv(2)=pizda(1,2)+pizda(2,1)
7632 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7633 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7634 C Explicit gradient in virtual-dihedral angles.
7635 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7636 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7637 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7638 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7639 vv(1)=pizda(1,1)-pizda(2,2)
7640 vv(2)=pizda(1,2)+pizda(2,1)
7641 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7642 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7643 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7644 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7645 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7646 vv(1)=pizda(1,1)-pizda(2,2)
7647 vv(2)=pizda(1,2)+pizda(2,1)
7648 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7649 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7650 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7651 C Cartesian gradient
7655 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7657 vv(1)=pizda(1,1)-pizda(2,2)
7658 vv(2)=pizda(1,2)+pizda(2,1)
7659 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7660 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7661 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7666 C Contribution from graph IV
7668 call transpose2(EE(1,1,itl),auxmat(1,1))
7669 call matmat2(auxmat(1,1),AEA(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 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7673 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7674 C Explicit gradient in virtual-dihedral angles.
7675 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7676 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7677 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7678 vv(1)=pizda(1,1)+pizda(2,2)
7679 vv(2)=pizda(2,1)-pizda(1,2)
7680 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7681 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7682 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7683 C Cartesian gradient
7687 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7689 vv(1)=pizda(1,1)+pizda(2,2)
7690 vv(2)=pizda(2,1)-pizda(1,2)
7691 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7692 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7693 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7698 C Antiparallel orientation
7699 C Contribution from graph III
7701 call transpose2(EUg(1,1,j),auxmat(1,1))
7702 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7703 vv(1)=pizda(1,1)-pizda(2,2)
7704 vv(2)=pizda(1,2)+pizda(2,1)
7705 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7706 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7707 C Explicit gradient in virtual-dihedral angles.
7708 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7709 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7710 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7711 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7712 vv(1)=pizda(1,1)-pizda(2,2)
7713 vv(2)=pizda(1,2)+pizda(2,1)
7714 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7715 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7716 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7717 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7718 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7719 vv(1)=pizda(1,1)-pizda(2,2)
7720 vv(2)=pizda(1,2)+pizda(2,1)
7721 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7722 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7723 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7724 C Cartesian gradient
7728 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7730 vv(1)=pizda(1,1)-pizda(2,2)
7731 vv(2)=pizda(1,2)+pizda(2,1)
7732 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7733 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7734 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7739 C Contribution from graph IV
7741 call transpose2(EE(1,1,itj),auxmat(1,1))
7742 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7743 vv(1)=pizda(1,1)+pizda(2,2)
7744 vv(2)=pizda(2,1)-pizda(1,2)
7745 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7746 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7747 C Explicit gradient in virtual-dihedral angles.
7748 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7749 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7750 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7751 vv(1)=pizda(1,1)+pizda(2,2)
7752 vv(2)=pizda(2,1)-pizda(1,2)
7753 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7754 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7755 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7756 C Cartesian gradient
7760 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7762 vv(1)=pizda(1,1)+pizda(2,2)
7763 vv(2)=pizda(2,1)-pizda(1,2)
7764 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7765 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7766 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7772 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7773 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7774 cd write (2,*) 'ijkl',i,j,k,l
7775 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7776 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7778 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7779 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7780 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7781 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7782 if (j.lt.nres-1) then
7789 if (l.lt.nres-1) then
7799 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7800 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7801 C summed up outside the subrouine as for the other subroutines
7802 C handling long-range interactions. The old code is commented out
7803 C with "cgrad" to keep track of changes.
7805 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7806 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7807 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7808 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7809 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7810 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7811 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7812 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7813 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7814 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7816 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7817 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7818 cgrad ghalf=0.5d0*ggg1(ll)
7820 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7821 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7822 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7823 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7824 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7825 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7826 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7827 cgrad ghalf=0.5d0*ggg2(ll)
7829 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
7830 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7831 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
7832 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7833 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7834 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7839 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7840 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7845 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7846 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7852 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7857 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7861 cd write (2,*) iii,g_corr5_loc(iii)
7864 cd write (2,*) 'ekont',ekont
7865 cd write (iout,*) 'eello5',ekont*eel5
7868 c--------------------------------------------------------------------------
7869 double precision function eello6(i,j,k,l,jj,kk)
7870 implicit real*8 (a-h,o-z)
7871 include 'DIMENSIONS'
7872 include 'COMMON.IOUNITS'
7873 include 'COMMON.CHAIN'
7874 include 'COMMON.DERIV'
7875 include 'COMMON.INTERACT'
7876 include 'COMMON.CONTACTS'
7877 include 'COMMON.TORSION'
7878 include 'COMMON.VAR'
7879 include 'COMMON.GEO'
7880 include 'COMMON.FFIELD'
7881 double precision ggg1(3),ggg2(3)
7882 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7887 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7895 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7896 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7900 derx(lll,kkk,iii)=0.0d0
7904 cd eij=facont_hb(jj,i)
7905 cd ekl=facont_hb(kk,k)
7911 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7912 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7913 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7914 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7915 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7916 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7918 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7919 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7920 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7921 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7922 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7923 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7927 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7929 C If turn contributions are considered, they will be handled separately.
7930 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7931 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7932 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7933 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7934 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7935 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7936 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7938 if (j.lt.nres-1) then
7945 if (l.lt.nres-1) then
7953 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7954 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7955 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7956 cgrad ghalf=0.5d0*ggg1(ll)
7958 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7959 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7960 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7961 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7962 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7963 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7964 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7965 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7966 cgrad ghalf=0.5d0*ggg2(ll)
7967 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7969 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7970 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7971 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7972 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7973 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7974 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7979 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7980 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7985 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7986 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7992 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7997 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8001 cd write (2,*) iii,g_corr6_loc(iii)
8004 cd write (2,*) 'ekont',ekont
8005 cd write (iout,*) 'eello6',ekont*eel6
8008 c--------------------------------------------------------------------------
8009 double precision function eello6_graph1(i,j,k,l,imat,swap)
8010 implicit real*8 (a-h,o-z)
8011 include 'DIMENSIONS'
8012 include 'COMMON.IOUNITS'
8013 include 'COMMON.CHAIN'
8014 include 'COMMON.DERIV'
8015 include 'COMMON.INTERACT'
8016 include 'COMMON.CONTACTS'
8017 include 'COMMON.TORSION'
8018 include 'COMMON.VAR'
8019 include 'COMMON.GEO'
8020 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8024 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8026 C Parallel Antiparallel C
8032 C \ j|/k\| / \ |/k\|l / C
8037 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8038 itk=itortyp(itype(k))
8039 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8040 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8041 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8042 call transpose2(EUgC(1,1,k),auxmat(1,1))
8043 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8044 vv1(1)=pizda1(1,1)-pizda1(2,2)
8045 vv1(2)=pizda1(1,2)+pizda1(2,1)
8046 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8047 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8048 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8049 s5=scalar2(vv(1),Dtobr2(1,i))
8050 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8051 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8052 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8053 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8054 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8055 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8056 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8057 & +scalar2(vv(1),Dtobr2der(1,i)))
8058 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8059 vv1(1)=pizda1(1,1)-pizda1(2,2)
8060 vv1(2)=pizda1(1,2)+pizda1(2,1)
8061 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8062 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8064 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8065 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8066 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8067 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8068 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8070 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8071 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8072 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8073 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8074 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8076 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8077 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8078 vv1(1)=pizda1(1,1)-pizda1(2,2)
8079 vv1(2)=pizda1(1,2)+pizda1(2,1)
8080 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8081 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8082 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8083 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8092 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8093 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8094 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8095 call transpose2(EUgC(1,1,k),auxmat(1,1))
8096 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8098 vv1(1)=pizda1(1,1)-pizda1(2,2)
8099 vv1(2)=pizda1(1,2)+pizda1(2,1)
8100 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8101 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8102 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8103 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8104 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8105 s5=scalar2(vv(1),Dtobr2(1,i))
8106 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8112 c----------------------------------------------------------------------------
8113 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8114 implicit real*8 (a-h,o-z)
8115 include 'DIMENSIONS'
8116 include 'COMMON.IOUNITS'
8117 include 'COMMON.CHAIN'
8118 include 'COMMON.DERIV'
8119 include 'COMMON.INTERACT'
8120 include 'COMMON.CONTACTS'
8121 include 'COMMON.TORSION'
8122 include 'COMMON.VAR'
8123 include 'COMMON.GEO'
8125 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8126 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8129 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8131 C Parallel Antiparallel C
8137 C \ j|/k\| \ |/k\|l C
8142 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8143 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8144 C AL 7/4/01 s1 would occur in the sixth-order moment,
8145 C but not in a cluster cumulant
8147 s1=dip(1,jj,i)*dip(1,kk,k)
8149 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8150 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8151 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8152 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8153 call transpose2(EUg(1,1,k),auxmat(1,1))
8154 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8155 vv(1)=pizda(1,1)-pizda(2,2)
8156 vv(2)=pizda(1,2)+pizda(2,1)
8157 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8158 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8160 eello6_graph2=-(s1+s2+s3+s4)
8162 eello6_graph2=-(s2+s3+s4)
8165 C Derivatives in gamma(i-1)
8168 s1=dipderg(1,jj,i)*dip(1,kk,k)
8170 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8171 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8172 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8173 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8175 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8177 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8179 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8181 C Derivatives in gamma(k-1)
8183 s1=dip(1,jj,i)*dipderg(1,kk,k)
8185 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8186 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8187 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8188 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8189 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8190 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8191 vv(1)=pizda(1,1)-pizda(2,2)
8192 vv(2)=pizda(1,2)+pizda(2,1)
8193 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8195 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8197 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8199 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8200 C Derivatives in gamma(j-1) or gamma(l-1)
8203 s1=dipderg(3,jj,i)*dip(1,kk,k)
8205 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8206 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8207 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8208 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8209 vv(1)=pizda(1,1)-pizda(2,2)
8210 vv(2)=pizda(1,2)+pizda(2,1)
8211 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8214 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8216 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8219 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8220 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8222 C Derivatives in gamma(l-1) or gamma(j-1)
8225 s1=dip(1,jj,i)*dipderg(3,kk,k)
8227 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8228 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8229 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8230 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8231 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8232 vv(1)=pizda(1,1)-pizda(2,2)
8233 vv(2)=pizda(1,2)+pizda(2,1)
8234 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8237 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8239 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8242 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8243 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8245 C Cartesian derivatives.
8247 write (2,*) 'In eello6_graph2'
8249 write (2,*) 'iii=',iii
8251 write (2,*) 'kkk=',kkk
8253 write (2,'(3(2f10.5),5x)')
8254 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8264 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8266 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8269 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8271 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8272 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8274 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8275 call transpose2(EUg(1,1,k),auxmat(1,1))
8276 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8278 vv(1)=pizda(1,1)-pizda(2,2)
8279 vv(2)=pizda(1,2)+pizda(2,1)
8280 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8281 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8283 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8285 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8288 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8290 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8297 c----------------------------------------------------------------------------
8298 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8299 implicit real*8 (a-h,o-z)
8300 include 'DIMENSIONS'
8301 include 'COMMON.IOUNITS'
8302 include 'COMMON.CHAIN'
8303 include 'COMMON.DERIV'
8304 include 'COMMON.INTERACT'
8305 include 'COMMON.CONTACTS'
8306 include 'COMMON.TORSION'
8307 include 'COMMON.VAR'
8308 include 'COMMON.GEO'
8309 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8311 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8313 C Parallel Antiparallel C
8319 C j|/k\| / |/k\|l / C
8324 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8326 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8327 C energy moment and not to the cluster cumulant.
8328 iti=itortyp(itype(i))
8329 if (j.lt.nres-1) then
8330 itj1=itortyp(itype(j+1))
8334 itk=itortyp(itype(k))
8335 itk1=itortyp(itype(k+1))
8336 if (l.lt.nres-1) then
8337 itl1=itortyp(itype(l+1))
8342 s1=dip(4,jj,i)*dip(4,kk,k)
8344 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8345 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8346 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8347 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8348 call transpose2(EE(1,1,itk),auxmat(1,1))
8349 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8350 vv(1)=pizda(1,1)+pizda(2,2)
8351 vv(2)=pizda(2,1)-pizda(1,2)
8352 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8353 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8354 cd & "sum",-(s2+s3+s4)
8356 eello6_graph3=-(s1+s2+s3+s4)
8358 eello6_graph3=-(s2+s3+s4)
8361 C Derivatives in gamma(k-1)
8362 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8363 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8364 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8365 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8366 C Derivatives in gamma(l-1)
8367 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8368 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8369 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8370 vv(1)=pizda(1,1)+pizda(2,2)
8371 vv(2)=pizda(2,1)-pizda(1,2)
8372 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8373 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8374 C Cartesian derivatives.
8380 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8382 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8385 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8387 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8388 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8390 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8391 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8393 vv(1)=pizda(1,1)+pizda(2,2)
8394 vv(2)=pizda(2,1)-pizda(1,2)
8395 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8397 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8399 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8402 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8404 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8406 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8412 c----------------------------------------------------------------------------
8413 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8414 implicit real*8 (a-h,o-z)
8415 include 'DIMENSIONS'
8416 include 'COMMON.IOUNITS'
8417 include 'COMMON.CHAIN'
8418 include 'COMMON.DERIV'
8419 include 'COMMON.INTERACT'
8420 include 'COMMON.CONTACTS'
8421 include 'COMMON.TORSION'
8422 include 'COMMON.VAR'
8423 include 'COMMON.GEO'
8424 include 'COMMON.FFIELD'
8425 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8426 & auxvec1(2),auxmat1(2,2)
8428 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8430 C Parallel Antiparallel C
8436 C \ j|/k\| \ |/k\|l C
8441 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8443 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8444 C energy moment and not to the cluster cumulant.
8445 cd write (2,*) 'eello_graph4: wturn6',wturn6
8446 iti=itortyp(itype(i))
8447 itj=itortyp(itype(j))
8448 if (j.lt.nres-1) then
8449 itj1=itortyp(itype(j+1))
8453 itk=itortyp(itype(k))
8454 if (k.lt.nres-1) then
8455 itk1=itortyp(itype(k+1))
8459 itl=itortyp(itype(l))
8460 if (l.lt.nres-1) then
8461 itl1=itortyp(itype(l+1))
8465 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8466 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8467 cd & ' itl',itl,' itl1',itl1
8470 s1=dip(3,jj,i)*dip(3,kk,k)
8472 s1=dip(2,jj,j)*dip(2,kk,l)
8475 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8476 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8478 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8479 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8481 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8482 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8484 call transpose2(EUg(1,1,k),auxmat(1,1))
8485 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8486 vv(1)=pizda(1,1)-pizda(2,2)
8487 vv(2)=pizda(2,1)+pizda(1,2)
8488 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8489 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8491 eello6_graph4=-(s1+s2+s3+s4)
8493 eello6_graph4=-(s2+s3+s4)
8495 C Derivatives in gamma(i-1)
8499 s1=dipderg(2,jj,i)*dip(3,kk,k)
8501 s1=dipderg(4,jj,j)*dip(2,kk,l)
8504 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8506 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8507 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8509 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8510 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8512 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8513 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8514 cd write (2,*) 'turn6 derivatives'
8516 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8518 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8522 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8524 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8528 C Derivatives in gamma(k-1)
8531 s1=dip(3,jj,i)*dipderg(2,kk,k)
8533 s1=dip(2,jj,j)*dipderg(4,kk,l)
8536 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8537 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8539 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8540 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8542 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8543 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8545 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8546 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8547 vv(1)=pizda(1,1)-pizda(2,2)
8548 vv(2)=pizda(2,1)+pizda(1,2)
8549 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8550 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8552 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8554 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8558 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8560 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8563 C Derivatives in gamma(j-1) or gamma(l-1)
8564 if (l.eq.j+1 .and. l.gt.1) then
8565 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8566 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8567 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8568 vv(1)=pizda(1,1)-pizda(2,2)
8569 vv(2)=pizda(2,1)+pizda(1,2)
8570 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8571 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8572 else if (j.gt.1) then
8573 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8574 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8575 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8576 vv(1)=pizda(1,1)-pizda(2,2)
8577 vv(2)=pizda(2,1)+pizda(1,2)
8578 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8579 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8580 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8582 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8585 C Cartesian derivatives.
8592 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8594 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8598 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8600 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8604 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8606 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8608 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8609 & b1(1,itj1),auxvec(1))
8610 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8612 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8613 & b1(1,itl1),auxvec(1))
8614 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8616 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8618 vv(1)=pizda(1,1)-pizda(2,2)
8619 vv(2)=pizda(2,1)+pizda(1,2)
8620 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8622 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8624 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8627 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8630 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8633 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8635 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8637 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8641 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8643 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8646 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8648 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8656 c----------------------------------------------------------------------------
8657 double precision function eello_turn6(i,jj,kk)
8658 implicit real*8 (a-h,o-z)
8659 include 'DIMENSIONS'
8660 include 'COMMON.IOUNITS'
8661 include 'COMMON.CHAIN'
8662 include 'COMMON.DERIV'
8663 include 'COMMON.INTERACT'
8664 include 'COMMON.CONTACTS'
8665 include 'COMMON.TORSION'
8666 include 'COMMON.VAR'
8667 include 'COMMON.GEO'
8668 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8669 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8671 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8672 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8673 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8674 C the respective energy moment and not to the cluster cumulant.
8683 iti=itortyp(itype(i))
8684 itk=itortyp(itype(k))
8685 itk1=itortyp(itype(k+1))
8686 itl=itortyp(itype(l))
8687 itj=itortyp(itype(j))
8688 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8689 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8690 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8695 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8697 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8701 derx_turn(lll,kkk,iii)=0.0d0
8708 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8710 cd write (2,*) 'eello6_5',eello6_5
8712 call transpose2(AEA(1,1,1),auxmat(1,1))
8713 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8714 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8715 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8717 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8718 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8719 s2 = scalar2(b1(1,itk),vtemp1(1))
8721 call transpose2(AEA(1,1,2),atemp(1,1))
8722 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8723 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8724 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8726 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8727 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8728 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8730 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8731 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8732 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8733 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8734 ss13 = scalar2(b1(1,itk),vtemp4(1))
8735 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8737 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8743 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8744 C Derivatives in gamma(i+2)
8748 call transpose2(AEA(1,1,1),auxmatd(1,1))
8749 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8750 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8751 call transpose2(AEAderg(1,1,2),atempd(1,1))
8752 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8753 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8755 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8756 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8757 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8763 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8764 C Derivatives in gamma(i+3)
8766 call transpose2(AEA(1,1,1),auxmatd(1,1))
8767 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8768 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8769 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8771 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8772 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8773 s2d = scalar2(b1(1,itk),vtemp1d(1))
8775 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8776 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8778 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8780 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8781 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8782 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8790 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8791 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8793 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8794 & -0.5d0*ekont*(s2d+s12d)
8796 C Derivatives in gamma(i+4)
8797 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8798 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8799 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8801 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8802 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8803 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8811 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8813 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8815 C Derivatives in gamma(i+5)
8817 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8818 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8819 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8821 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8822 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8823 s2d = scalar2(b1(1,itk),vtemp1d(1))
8825 call transpose2(AEA(1,1,2),atempd(1,1))
8826 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8827 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8829 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8830 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8832 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8833 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8834 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8842 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8843 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8845 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8846 & -0.5d0*ekont*(s2d+s12d)
8848 C Cartesian derivatives
8853 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8854 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8855 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8857 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8858 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8860 s2d = scalar2(b1(1,itk),vtemp1d(1))
8862 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8863 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8864 s8d = -(atempd(1,1)+atempd(2,2))*
8865 & scalar2(cc(1,1,itl),vtemp2(1))
8867 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8869 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8870 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8877 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8880 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8884 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8885 & - 0.5d0*(s8d+s12d)
8887 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8896 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8898 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8899 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8900 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8901 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8902 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8904 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8905 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8906 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8910 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8911 cd & 16*eel_turn6_num
8913 if (j.lt.nres-1) then
8920 if (l.lt.nres-1) then
8928 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8929 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8930 cgrad ghalf=0.5d0*ggg1(ll)
8932 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8933 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8934 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8935 & +ekont*derx_turn(ll,2,1)
8936 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8937 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8938 & +ekont*derx_turn(ll,4,1)
8939 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8940 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8941 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8942 cgrad ghalf=0.5d0*ggg2(ll)
8944 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8945 & +ekont*derx_turn(ll,2,2)
8946 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8947 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8948 & +ekont*derx_turn(ll,4,2)
8949 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8950 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8951 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8956 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8961 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8967 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8972 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8976 cd write (2,*) iii,g_corr6_loc(iii)
8978 eello_turn6=ekont*eel_turn6
8979 cd write (2,*) 'ekont',ekont
8980 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8984 C-----------------------------------------------------------------------------
8985 double precision function scalar(u,v)
8986 !DIR$ INLINEALWAYS scalar
8988 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8991 double precision u(3),v(3)
8992 cd double precision sc
9000 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9003 crc-------------------------------------------------
9004 SUBROUTINE MATVEC2(A1,V1,V2)
9005 !DIR$ INLINEALWAYS MATVEC2
9007 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9009 implicit real*8 (a-h,o-z)
9010 include 'DIMENSIONS'
9011 DIMENSION A1(2,2),V1(2),V2(2)
9015 c 3 VI=VI+A1(I,K)*V1(K)
9019 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9020 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9025 C---------------------------------------
9026 SUBROUTINE MATMAT2(A1,A2,A3)
9028 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9030 implicit real*8 (a-h,o-z)
9031 include 'DIMENSIONS'
9032 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9033 c DIMENSION AI3(2,2)
9037 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9043 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9044 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9045 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9046 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9054 c-------------------------------------------------------------------------
9055 double precision function scalar2(u,v)
9056 !DIR$ INLINEALWAYS scalar2
9058 double precision u(2),v(2)
9061 scalar2=u(1)*v(1)+u(2)*v(2)
9065 C-----------------------------------------------------------------------------
9067 subroutine transpose2(a,at)
9068 !DIR$ INLINEALWAYS transpose2
9070 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9073 double precision a(2,2),at(2,2)
9080 c--------------------------------------------------------------------------
9081 subroutine transpose(n,a,at)
9084 double precision a(n,n),at(n,n)
9092 C---------------------------------------------------------------------------
9093 subroutine prodmat3(a1,a2,kk,transp,prod)
9094 !DIR$ INLINEALWAYS prodmat3
9096 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9100 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9102 crc double precision auxmat(2,2),prod_(2,2)
9105 crc call transpose2(kk(1,1),auxmat(1,1))
9106 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9107 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9109 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9110 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9111 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9112 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9113 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9114 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9115 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9116 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9119 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9120 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9122 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9123 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9124 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9125 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9126 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9127 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9128 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9129 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9132 c call transpose2(a2(1,1),a2t(1,1))
9135 crc print *,((prod_(i,j),i=1,2),j=1,2)
9136 crc print *,((prod(i,j),i=1,2),j=1,2)