1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
28 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
29 c & " nfgtasks",nfgtasks
30 if (nfgtasks.gt.1) then
32 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
33 if (fg_rank.eq.0) then
34 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
35 c print *,"Processor",myrank," BROADCAST iorder"
36 C FG master sets up the WEIGHTS_ array which will be broadcast to the
37 C FG slaves as WEIGHTS array.
57 C FG Master broadcasts the WEIGHTS_ array
58 call MPI_Bcast(weights_(1),n_ene,
59 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
61 C FG slaves receive the WEIGHTS array
62 call MPI_Bcast(weights(1),n_ene,
63 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
84 time_Bcast=time_Bcast+MPI_Wtime()-time00
85 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
86 c call chainbuild_cart
88 c print *,'Processor',myrank,' calling etotal ipot=',ipot
89 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
91 c if (modecalc.eq.12.or.modecalc.eq.14) then
92 c call int_from_cart1(.false.)
99 C Compute the side-chain and electrostatic interaction energy
101 goto (101,102,103,104,105,106) ipot
102 C Lennard-Jones potential.
104 cd print '(a)','Exit ELJ'
106 C Lennard-Jones-Kihara potential (shifted).
109 C Berne-Pechukas potential (dilated LJ, angular dependence).
112 C Gay-Berne potential (shifted LJ, angular dependence).
115 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
118 C Soft-sphere potential
119 106 call e_softsphere(evdw)
121 C Calculate electrostatic (H-bonding) energy of the main chain.
125 cmc Sep-06: egb takes care of dynamic ss bonds too
127 c if (dyn_ss) call dyn_set_nss
129 c print *,"Processor",myrank," computed USCSC"
135 time_vec=time_vec+MPI_Wtime()-time01
137 c print *,"Processor",myrank," left VEC_AND_DERIV"
140 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
141 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
142 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
143 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
145 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
146 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
147 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
148 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
150 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
159 c write (iout,*) "Soft-spheer ELEC potential"
160 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
163 c print *,"Processor",myrank," computed UELEC"
165 C Calculate excluded-volume interaction energy between peptide groups
170 call escp(evdw2,evdw2_14)
176 c write (iout,*) "Soft-sphere SCP potential"
177 call escp_soft_sphere(evdw2,evdw2_14)
180 c Calculate the bond-stretching energy
184 C Calculate the disulfide-bridge and other energy and the contributions
185 C from other distance constraints.
186 cd print *,'Calling EHPB'
188 cd print *,'EHPB exitted succesfully.'
190 C Calculate the virtual-bond-angle energy.
192 if (wang.gt.0d0) then
197 c print *,"Processor",myrank," computed UB"
199 C Calculate the SC local energy.
202 c print *,"Processor",myrank," computed USC"
204 C Calculate the virtual-bond torsional energy.
206 cd print *,'nterm=',nterm
208 call etor(etors,edihcnstr)
213 c print *,"Processor",myrank," computed Utor"
215 C 6/23/01 Calculate double-torsional energy
217 if (wtor_d.gt.0) then
222 c print *,"Processor",myrank," computed Utord"
224 C 21/5/07 Calculate local sicdechain correlation energy
226 if (wsccor.gt.0.0d0) then
227 call eback_sc_corr(esccor)
231 c print *,"Processor",myrank," computed Usccorr"
233 C 12/1/95 Multi-body terms
237 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
238 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
239 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
240 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
241 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
248 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
249 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
250 cd write (iout,*) "multibody_hb ecorr",ecorr
252 c print *,"Processor",myrank," computed Ucorr"
254 C If performing constraint dynamics, call the constraint energy
255 C after the equilibration time
256 if(usampl.and.totT.gt.eq_time) then
264 time_enecalc=time_enecalc+MPI_Wtime()-time00
266 c print *,"Processor",myrank," computed Uconstr"
275 energia(2)=evdw2-evdw2_14
292 energia(8)=eello_turn3
293 energia(9)=eello_turn4
300 energia(19)=edihcnstr
302 energia(20)=Uconst+Uconst_back
304 c Here are the energies showed per procesor if the are more processors
305 c per molecule then we sum it up in sum_energy subroutine
306 c print *," Processor",myrank," calls SUM_ENERGY"
307 call sum_energy(energia,.true.)
308 if (dyn_ss) call dyn_set_nss
309 c print *," Processor",myrank," left SUM_ENERGY"
311 time_sumene=time_sumene+MPI_Wtime()-time00
315 c-------------------------------------------------------------------------------
316 subroutine sum_energy(energia,reduce)
317 implicit real*8 (a-h,o-z)
322 cMS$ATTRIBUTES C :: proc_proc
328 include 'COMMON.SETUP'
329 include 'COMMON.IOUNITS'
330 double precision energia(0:n_ene),enebuff(0:n_ene+1)
331 include 'COMMON.FFIELD'
332 include 'COMMON.DERIV'
333 include 'COMMON.INTERACT'
334 include 'COMMON.SBRIDGE'
335 include 'COMMON.CHAIN'
337 include 'COMMON.CONTROL'
338 include 'COMMON.TIME1'
341 if (nfgtasks.gt.1 .and. reduce) then
343 write (iout,*) "energies before REDUCE"
344 call enerprint(energia)
348 enebuff(i)=energia(i)
351 call MPI_Barrier(FG_COMM,IERR)
352 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
354 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
355 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
357 write (iout,*) "energies after REDUCE"
358 call enerprint(energia)
361 time_Reduce=time_Reduce+MPI_Wtime()-time00
363 if (fg_rank.eq.0) then
367 evdw2=energia(2)+energia(18)
383 eello_turn3=energia(8)
384 eello_turn4=energia(9)
391 edihcnstr=energia(19)
396 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
397 & +wang*ebe+wtor*etors+wscloc*escloc
398 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
399 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
400 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
401 & +wbond*estr+Uconst+wsccor*esccor
403 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
404 & +wang*ebe+wtor*etors+wscloc*escloc
405 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
406 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
407 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
408 & +wbond*estr+Uconst+wsccor*esccor
414 if (isnan(etot).ne.0) energia(0)=1.0d+99
416 if (isnan(etot)) energia(0)=1.0d+99
421 idumm=proc_proc(etot,i)
423 call proc_proc(etot,i)
425 if(i.eq.1)energia(0)=1.0d+99
432 c-------------------------------------------------------------------------------
433 subroutine sum_gradient
434 implicit real*8 (a-h,o-z)
439 cMS$ATTRIBUTES C :: proc_proc
444 double precision gradbufc(3,maxres),gradbufx(3,maxres),
445 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
447 include 'COMMON.SETUP'
448 include 'COMMON.IOUNITS'
449 include 'COMMON.FFIELD'
450 include 'COMMON.DERIV'
451 include 'COMMON.INTERACT'
452 include 'COMMON.SBRIDGE'
453 include 'COMMON.CHAIN'
455 include 'COMMON.CONTROL'
456 include 'COMMON.TIME1'
457 include 'COMMON.MAXGRAD'
458 include 'COMMON.SCCOR'
463 write (iout,*) "sum_gradient gvdwc, gvdwx"
465 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
466 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
471 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
472 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
473 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
476 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
477 C in virtual-bond-vector coordinates
480 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
482 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
483 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
485 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
487 c write (iout,'(i5,3f10.5,2x,f10.5)')
488 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
490 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
492 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
493 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
501 gradbufc(j,i)=wsc*gvdwc(j,i)+
502 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
503 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
504 & wel_loc*gel_loc_long(j,i)+
505 & wcorr*gradcorr_long(j,i)+
506 & wcorr5*gradcorr5_long(j,i)+
507 & wcorr6*gradcorr6_long(j,i)+
508 & wturn6*gcorr6_turn_long(j,i)+
515 gradbufc(j,i)=wsc*gvdwc(j,i)+
516 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
517 & welec*gelc_long(j,i)+
519 & wel_loc*gel_loc_long(j,i)+
520 & wcorr*gradcorr_long(j,i)+
521 & wcorr5*gradcorr5_long(j,i)+
522 & wcorr6*gradcorr6_long(j,i)+
523 & wturn6*gcorr6_turn_long(j,i)+
529 if (nfgtasks.gt.1) then
532 write (iout,*) "gradbufc before allreduce"
534 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
540 gradbufc_sum(j,i)=gradbufc(j,i)
543 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
544 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
545 c time_reduce=time_reduce+MPI_Wtime()-time00
547 c write (iout,*) "gradbufc_sum after allreduce"
549 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
554 c time_allreduce=time_allreduce+MPI_Wtime()-time00
562 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
563 write (iout,*) (i," jgrad_start",jgrad_start(i),
564 & " jgrad_end ",jgrad_end(i),
565 & i=igrad_start,igrad_end)
568 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
569 c do not parallelize this part.
571 c do i=igrad_start,igrad_end
572 c do j=jgrad_start(i),jgrad_end(i)
574 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
579 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
583 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
587 write (iout,*) "gradbufc after summing"
589 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
596 write (iout,*) "gradbufc"
598 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
604 gradbufc_sum(j,i)=gradbufc(j,i)
609 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
613 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
618 c gradbufc(k,i)=0.0d0
622 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
627 write (iout,*) "gradbufc after summing"
629 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
637 gradbufc(k,nres)=0.0d0
642 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
643 & wel_loc*gel_loc(j,i)+
644 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
645 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
646 & wel_loc*gel_loc_long(j,i)+
647 & wcorr*gradcorr_long(j,i)+
648 & wcorr5*gradcorr5_long(j,i)+
649 & wcorr6*gradcorr6_long(j,i)+
650 & wturn6*gcorr6_turn_long(j,i))+
652 & wcorr*gradcorr(j,i)+
653 & wturn3*gcorr3_turn(j,i)+
654 & wturn4*gcorr4_turn(j,i)+
655 & wcorr5*gradcorr5(j,i)+
656 & wcorr6*gradcorr6(j,i)+
657 & wturn6*gcorr6_turn(j,i)+
658 & wsccor*gsccorc(j,i)
659 & +wscloc*gscloc(j,i)
661 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
662 & wel_loc*gel_loc(j,i)+
663 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
664 & welec*gelc_long(j,i)
665 & wel_loc*gel_loc_long(j,i)+
666 & wcorr*gcorr_long(j,i)+
667 & wcorr5*gradcorr5_long(j,i)+
668 & wcorr6*gradcorr6_long(j,i)+
669 & wturn6*gcorr6_turn_long(j,i))+
671 & wcorr*gradcorr(j,i)+
672 & wturn3*gcorr3_turn(j,i)+
673 & wturn4*gcorr4_turn(j,i)+
674 & wcorr5*gradcorr5(j,i)+
675 & wcorr6*gradcorr6(j,i)+
676 & wturn6*gcorr6_turn(j,i)+
677 & wsccor*gsccorc(j,i)
678 & +wscloc*gscloc(j,i)
680 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
682 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
683 & wsccor*gsccorx(j,i)
684 & +wscloc*gsclocx(j,i)
688 write (iout,*) "gloc before adding corr"
690 write (iout,*) i,gloc(i,icg)
694 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
695 & +wcorr5*g_corr5_loc(i)
696 & +wcorr6*g_corr6_loc(i)
697 & +wturn4*gel_loc_turn4(i)
698 & +wturn3*gel_loc_turn3(i)
699 & +wturn6*gel_loc_turn6(i)
700 & +wel_loc*gel_loc_loc(i)
703 write (iout,*) "gloc after adding corr"
705 write (iout,*) i,gloc(i,icg)
709 if (nfgtasks.gt.1) then
712 gradbufc(j,i)=gradc(j,i,icg)
713 gradbufx(j,i)=gradx(j,i,icg)
717 glocbuf(i)=gloc(i,icg)
721 write (iout,*) "gloc_sc before reduce"
724 write (iout,*) i,j,gloc_sc(j,i,icg)
731 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
735 call MPI_Barrier(FG_COMM,IERR)
736 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
738 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
739 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
740 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
741 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
742 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
743 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
744 time_reduce=time_reduce+MPI_Wtime()-time00
745 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
746 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
747 time_reduce=time_reduce+MPI_Wtime()-time00
750 write (iout,*) "gloc_sc after reduce"
753 write (iout,*) i,j,gloc_sc(j,i,icg)
759 write (iout,*) "gloc after reduce"
761 write (iout,*) i,gloc(i,icg)
766 if (gnorm_check) then
768 c Compute the maximum elements of the gradient
778 gcorr3_turn_max=0.0d0
779 gcorr4_turn_max=0.0d0
782 gcorr6_turn_max=0.0d0
792 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
793 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
794 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
795 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
796 & gvdwc_scp_max=gvdwc_scp_norm
797 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
798 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
799 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
800 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
801 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
802 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
803 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
804 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
805 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
806 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
807 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
808 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
809 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
811 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
812 & gcorr3_turn_max=gcorr3_turn_norm
813 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
815 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
816 & gcorr4_turn_max=gcorr4_turn_norm
817 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
818 if (gradcorr5_norm.gt.gradcorr5_max)
819 & gradcorr5_max=gradcorr5_norm
820 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
821 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
822 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
824 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
825 & gcorr6_turn_max=gcorr6_turn_norm
826 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
827 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
828 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
829 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
830 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
831 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
832 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
833 if (gradx_scp_norm.gt.gradx_scp_max)
834 & gradx_scp_max=gradx_scp_norm
835 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
836 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
837 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
838 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
839 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
840 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
841 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
842 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
846 open(istat,file=statname,position="append")
848 open(istat,file=statname,access="append")
850 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
851 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
852 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
853 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
854 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
855 & gsccorx_max,gsclocx_max
857 if (gvdwc_max.gt.1.0d4) then
858 write (iout,*) "gvdwc gvdwx gradb gradbx"
860 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
861 & gradb(j,i),gradbx(j,i),j=1,3)
863 call pdbout(0.0d0,'cipiszcze',iout)
869 write (iout,*) "gradc gradx gloc"
871 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
872 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
876 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
880 c-------------------------------------------------------------------------------
881 subroutine rescale_weights(t_bath)
882 implicit real*8 (a-h,o-z)
884 include 'COMMON.IOUNITS'
885 include 'COMMON.FFIELD'
886 include 'COMMON.SBRIDGE'
887 double precision kfac /2.4d0/
888 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
890 c facT=2*temp0/(t_bath+temp0)
891 if (rescale_mode.eq.0) then
897 else if (rescale_mode.eq.1) then
898 facT=kfac/(kfac-1.0d0+t_bath/temp0)
899 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
900 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
901 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
902 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
903 else if (rescale_mode.eq.2) then
909 facT=licznik/dlog(dexp(x)+dexp(-x))
910 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
911 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
912 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
913 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
915 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
916 write (*,*) "Wrong RESCALE_MODE",rescale_mode
918 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
922 welec=weights(3)*fact
923 wcorr=weights(4)*fact3
924 wcorr5=weights(5)*fact4
925 wcorr6=weights(6)*fact5
926 wel_loc=weights(7)*fact2
927 wturn3=weights(8)*fact2
928 wturn4=weights(9)*fact3
929 wturn6=weights(10)*fact5
930 wtor=weights(13)*fact
931 wtor_d=weights(14)*fact2
932 wsccor=weights(21)*fact
936 C------------------------------------------------------------------------
937 subroutine enerprint(energia)
938 implicit real*8 (a-h,o-z)
940 include 'COMMON.IOUNITS'
941 include 'COMMON.FFIELD'
942 include 'COMMON.SBRIDGE'
944 double precision energia(0:n_ene)
949 evdw2=energia(2)+energia(18)
961 eello_turn3=energia(8)
962 eello_turn4=energia(9)
963 eello_turn6=energia(10)
969 edihcnstr=energia(19)
974 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
975 & estr,wbond,ebe,wang,
976 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
978 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
979 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
982 10 format (/'Virtual-chain energies:'//
983 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
984 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
985 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
986 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
987 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
988 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
989 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
990 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
991 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
992 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
993 & ' (SS bridges & dist. cnstr.)'/
994 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
995 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
996 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
997 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
998 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
999 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1000 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1001 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1002 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1003 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1004 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1005 & 'ETOT= ',1pE16.6,' (total)')
1007 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1008 & estr,wbond,ebe,wang,
1009 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1011 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1012 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1013 & ebr*nss,Uconst,etot
1014 10 format (/'Virtual-chain energies:'//
1015 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1016 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1017 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1018 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1019 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1020 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1021 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1022 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1023 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1024 & ' (SS bridges & dist. cnstr.)'/
1025 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1026 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1027 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1028 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1029 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1030 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1031 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1032 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1033 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1034 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1035 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1036 & 'ETOT= ',1pE16.6,' (total)')
1040 C-----------------------------------------------------------------------
1041 subroutine elj(evdw)
1043 C This subroutine calculates the interaction energy of nonbonded side chains
1044 C assuming the LJ potential of interaction.
1046 implicit real*8 (a-h,o-z)
1047 include 'DIMENSIONS'
1048 parameter (accur=1.0d-10)
1049 include 'COMMON.GEO'
1050 include 'COMMON.VAR'
1051 include 'COMMON.LOCAL'
1052 include 'COMMON.CHAIN'
1053 include 'COMMON.DERIV'
1054 include 'COMMON.INTERACT'
1055 include 'COMMON.TORSION'
1056 include 'COMMON.SBRIDGE'
1057 include 'COMMON.NAMES'
1058 include 'COMMON.IOUNITS'
1059 include 'COMMON.CONTACTS'
1061 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1063 do i=iatsc_s,iatsc_e
1064 itypi=iabs(itype(i))
1065 if (itypi.eq.ntyp1) cycle
1066 itypi1=iabs(itype(i+1))
1073 C Calculate SC interaction energy.
1075 do iint=1,nint_gr(i)
1076 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1077 cd & 'iend=',iend(i,iint)
1078 do j=istart(i,iint),iend(i,iint)
1079 itypj=iabs(itype(j))
1080 if (itypj.eq.ntyp1) cycle
1084 C Change 12/1/95 to calculate four-body interactions
1085 rij=xj*xj+yj*yj+zj*zj
1087 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1088 eps0ij=eps(itypi,itypj)
1090 e1=fac*fac*aa(itypi,itypj)
1091 e2=fac*bb(itypi,itypj)
1093 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1094 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1095 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1096 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1097 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1098 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1101 C Calculate the components of the gradient in DC and X
1103 fac=-rrij*(e1+evdwij)
1108 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1109 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1110 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1111 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1115 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1119 C 12/1/95, revised on 5/20/97
1121 C Calculate the contact function. The ith column of the array JCONT will
1122 C contain the numbers of atoms that make contacts with the atom I (of numbers
1123 C greater than I). The arrays FACONT and GACONT will contain the values of
1124 C the contact function and its derivative.
1126 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1127 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1128 C Uncomment next line, if the correlation interactions are contact function only
1129 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1131 sigij=sigma(itypi,itypj)
1132 r0ij=rs0(itypi,itypj)
1134 C Check whether the SC's are not too far to make a contact.
1137 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1138 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1140 if (fcont.gt.0.0D0) then
1141 C If the SC-SC distance if close to sigma, apply spline.
1142 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1143 cAdam & fcont1,fprimcont1)
1144 cAdam fcont1=1.0d0-fcont1
1145 cAdam if (fcont1.gt.0.0d0) then
1146 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1147 cAdam fcont=fcont*fcont1
1149 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1150 cga eps0ij=1.0d0/dsqrt(eps0ij)
1152 cga gg(k)=gg(k)*eps0ij
1154 cga eps0ij=-evdwij*eps0ij
1155 C Uncomment for AL's type of SC correlation interactions.
1156 cadam eps0ij=-evdwij
1157 num_conti=num_conti+1
1158 jcont(num_conti,i)=j
1159 facont(num_conti,i)=fcont*eps0ij
1160 fprimcont=eps0ij*fprimcont/rij
1162 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1163 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1164 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1165 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1166 gacont(1,num_conti,i)=-fprimcont*xj
1167 gacont(2,num_conti,i)=-fprimcont*yj
1168 gacont(3,num_conti,i)=-fprimcont*zj
1169 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1170 cd write (iout,'(2i3,3f10.5)')
1171 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1177 num_cont(i)=num_conti
1181 gvdwc(j,i)=expon*gvdwc(j,i)
1182 gvdwx(j,i)=expon*gvdwx(j,i)
1185 C******************************************************************************
1189 C To save time, the factor of EXPON has been extracted from ALL components
1190 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1193 C******************************************************************************
1196 C-----------------------------------------------------------------------------
1197 subroutine eljk(evdw)
1199 C This subroutine calculates the interaction energy of nonbonded side chains
1200 C assuming the LJK potential of interaction.
1202 implicit real*8 (a-h,o-z)
1203 include 'DIMENSIONS'
1204 include 'COMMON.GEO'
1205 include 'COMMON.VAR'
1206 include 'COMMON.LOCAL'
1207 include 'COMMON.CHAIN'
1208 include 'COMMON.DERIV'
1209 include 'COMMON.INTERACT'
1210 include 'COMMON.IOUNITS'
1211 include 'COMMON.NAMES'
1214 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1216 do i=iatsc_s,iatsc_e
1217 itypi=iabs(itype(i))
1218 if (itypi.eq.ntyp1) cycle
1219 itypi1=iabs(itype(i+1))
1224 C Calculate SC interaction energy.
1226 do iint=1,nint_gr(i)
1227 do j=istart(i,iint),iend(i,iint)
1228 itypj=iabs(itype(j))
1229 if (itypj.eq.ntyp1) cycle
1233 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1234 fac_augm=rrij**expon
1235 e_augm=augm(itypi,itypj)*fac_augm
1236 r_inv_ij=dsqrt(rrij)
1238 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1239 fac=r_shift_inv**expon
1240 e1=fac*fac*aa(itypi,itypj)
1241 e2=fac*bb(itypi,itypj)
1243 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1244 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1245 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1246 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1247 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1248 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1249 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1252 C Calculate the components of the gradient in DC and X
1254 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1259 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1260 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1261 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1262 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1266 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1274 gvdwc(j,i)=expon*gvdwc(j,i)
1275 gvdwx(j,i)=expon*gvdwx(j,i)
1280 C-----------------------------------------------------------------------------
1281 subroutine ebp(evdw)
1283 C This subroutine calculates the interaction energy of nonbonded side chains
1284 C assuming the Berne-Pechukas potential of interaction.
1286 implicit real*8 (a-h,o-z)
1287 include 'DIMENSIONS'
1288 include 'COMMON.GEO'
1289 include 'COMMON.VAR'
1290 include 'COMMON.LOCAL'
1291 include 'COMMON.CHAIN'
1292 include 'COMMON.DERIV'
1293 include 'COMMON.NAMES'
1294 include 'COMMON.INTERACT'
1295 include 'COMMON.IOUNITS'
1296 include 'COMMON.CALC'
1297 common /srutu/ icall
1298 c double precision rrsave(maxdim)
1301 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1303 c if (icall.eq.0) then
1309 do i=iatsc_s,iatsc_e
1310 itypi=iabs(itype(i))
1311 if (itypi.eq.ntyp1) cycle
1312 itypi1=iabs(itype(i+1))
1316 dxi=dc_norm(1,nres+i)
1317 dyi=dc_norm(2,nres+i)
1318 dzi=dc_norm(3,nres+i)
1319 c dsci_inv=dsc_inv(itypi)
1320 dsci_inv=vbld_inv(i+nres)
1322 C Calculate SC interaction energy.
1324 do iint=1,nint_gr(i)
1325 do j=istart(i,iint),iend(i,iint)
1327 itypj=iabs(itype(j))
1328 if (itypj.eq.ntyp1) cycle
1329 c dscj_inv=dsc_inv(itypj)
1330 dscj_inv=vbld_inv(j+nres)
1331 chi1=chi(itypi,itypj)
1332 chi2=chi(itypj,itypi)
1339 alf12=0.5D0*(alf1+alf2)
1340 C For diagnostics only!!!
1353 dxj=dc_norm(1,nres+j)
1354 dyj=dc_norm(2,nres+j)
1355 dzj=dc_norm(3,nres+j)
1356 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1357 cd if (icall.eq.0) then
1363 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1365 C Calculate whole angle-dependent part of epsilon and contributions
1366 C to its derivatives
1367 fac=(rrij*sigsq)**expon2
1368 e1=fac*fac*aa(itypi,itypj)
1369 e2=fac*bb(itypi,itypj)
1370 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1371 eps2der=evdwij*eps3rt
1372 eps3der=evdwij*eps2rt
1373 evdwij=evdwij*eps2rt*eps3rt
1376 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1377 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1378 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1379 cd & restyp(itypi),i,restyp(itypj),j,
1380 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1381 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1382 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1385 C Calculate gradient components.
1386 e1=e1*eps1*eps2rt**2*eps3rt**2
1387 fac=-expon*(e1+evdwij)
1390 C Calculate radial part of the gradient
1394 C Calculate the angular part of the gradient and sum add the contributions
1395 C to the appropriate components of the Cartesian gradient.
1403 C-----------------------------------------------------------------------------
1404 subroutine egb(evdw)
1406 C This subroutine calculates the interaction energy of nonbonded side chains
1407 C assuming the Gay-Berne potential of interaction.
1409 implicit real*8 (a-h,o-z)
1410 include 'DIMENSIONS'
1411 include 'COMMON.GEO'
1412 include 'COMMON.VAR'
1413 include 'COMMON.LOCAL'
1414 include 'COMMON.CHAIN'
1415 include 'COMMON.DERIV'
1416 include 'COMMON.NAMES'
1417 include 'COMMON.INTERACT'
1418 include 'COMMON.IOUNITS'
1419 include 'COMMON.CALC'
1420 include 'COMMON.CONTROL'
1421 include 'COMMON.SBRIDGE'
1424 ccccc energy_dec=.false.
1425 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1428 c if (icall.eq.0) lprn=.false.
1430 do i=iatsc_s,iatsc_e
1431 itypi=iabs(itype(i))
1432 if (itypi.eq.ntyp1) cycle
1433 itypi1=iabs(itype(i+1))
1437 dxi=dc_norm(1,nres+i)
1438 dyi=dc_norm(2,nres+i)
1439 dzi=dc_norm(3,nres+i)
1440 c dsci_inv=dsc_inv(itypi)
1441 dsci_inv=vbld_inv(i+nres)
1442 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1443 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1445 C Calculate SC interaction energy.
1447 do iint=1,nint_gr(i)
1448 do j=istart(i,iint),iend(i,iint)
1449 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1450 call dyn_ssbond_ene(i,j,evdwij)
1452 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1453 & 'evdw',i,j,evdwij,' ss'
1456 itypj=iabs(itype(j))
1457 if (itypj.eq.ntyp1) cycle
1458 c dscj_inv=dsc_inv(itypj)
1459 dscj_inv=vbld_inv(j+nres)
1460 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1461 c & 1.0d0/vbld(j+nres)
1462 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1463 sig0ij=sigma(itypi,itypj)
1464 chi1=chi(itypi,itypj)
1465 chi2=chi(itypj,itypi)
1472 alf12=0.5D0*(alf1+alf2)
1473 C For diagnostics only!!!
1486 dxj=dc_norm(1,nres+j)
1487 dyj=dc_norm(2,nres+j)
1488 dzj=dc_norm(3,nres+j)
1489 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1490 c write (iout,*) "j",j," dc_norm",
1491 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1492 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1494 C Calculate angle-dependent terms of energy and contributions to their
1498 sig=sig0ij*dsqrt(sigsq)
1499 rij_shift=1.0D0/rij-sig+sig0ij
1500 c for diagnostics; uncomment
1501 c rij_shift=1.2*sig0ij
1502 C I hate to put IF's in the loops, but here don't have another choice!!!!
1503 if (rij_shift.le.0.0D0) then
1505 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1506 cd & restyp(itypi),i,restyp(itypj),j,
1507 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1511 c---------------------------------------------------------------
1512 rij_shift=1.0D0/rij_shift
1513 fac=rij_shift**expon
1514 e1=fac*fac*aa(itypi,itypj)
1515 e2=fac*bb(itypi,itypj)
1516 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1517 eps2der=evdwij*eps3rt
1518 eps3der=evdwij*eps2rt
1519 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1520 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1521 evdwij=evdwij*eps2rt*eps3rt
1524 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1525 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1526 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1527 & restyp(itypi),i,restyp(itypj),j,
1528 & epsi,sigm,chi1,chi2,chip1,chip2,
1529 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1530 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1534 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1537 C Calculate gradient components.
1538 e1=e1*eps1*eps2rt**2*eps3rt**2
1539 fac=-expon*(e1+evdwij)*rij_shift
1543 C Calculate the radial part of the gradient
1547 C Calculate angular part of the gradient.
1553 c write (iout,*) "Number of loop steps in EGB:",ind
1554 cccc energy_dec=.false.
1557 C-----------------------------------------------------------------------------
1558 subroutine egbv(evdw)
1560 C This subroutine calculates the interaction energy of nonbonded side chains
1561 C assuming the Gay-Berne-Vorobjev potential of interaction.
1563 implicit real*8 (a-h,o-z)
1564 include 'DIMENSIONS'
1565 include 'COMMON.GEO'
1566 include 'COMMON.VAR'
1567 include 'COMMON.LOCAL'
1568 include 'COMMON.CHAIN'
1569 include 'COMMON.DERIV'
1570 include 'COMMON.NAMES'
1571 include 'COMMON.INTERACT'
1572 include 'COMMON.IOUNITS'
1573 include 'COMMON.CALC'
1574 common /srutu/ icall
1577 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1580 c if (icall.eq.0) lprn=.true.
1582 do i=iatsc_s,iatsc_e
1583 itypi=iabs(itype(i))
1584 if (itypi.eq.ntyp1) cycle
1585 itypi1=iabs(itype(i+1))
1589 dxi=dc_norm(1,nres+i)
1590 dyi=dc_norm(2,nres+i)
1591 dzi=dc_norm(3,nres+i)
1592 c dsci_inv=dsc_inv(itypi)
1593 dsci_inv=vbld_inv(i+nres)
1595 C Calculate SC interaction energy.
1597 do iint=1,nint_gr(i)
1598 do j=istart(i,iint),iend(i,iint)
1600 itypj=iabs(itype(j))
1601 if (itypj.eq.ntyp1) cycle
1602 c dscj_inv=dsc_inv(itypj)
1603 dscj_inv=vbld_inv(j+nres)
1604 sig0ij=sigma(itypi,itypj)
1605 r0ij=r0(itypi,itypj)
1606 chi1=chi(itypi,itypj)
1607 chi2=chi(itypj,itypi)
1614 alf12=0.5D0*(alf1+alf2)
1615 C For diagnostics only!!!
1628 dxj=dc_norm(1,nres+j)
1629 dyj=dc_norm(2,nres+j)
1630 dzj=dc_norm(3,nres+j)
1631 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1633 C Calculate angle-dependent terms of energy and contributions to their
1637 sig=sig0ij*dsqrt(sigsq)
1638 rij_shift=1.0D0/rij-sig+r0ij
1639 C I hate to put IF's in the loops, but here don't have another choice!!!!
1640 if (rij_shift.le.0.0D0) then
1645 c---------------------------------------------------------------
1646 rij_shift=1.0D0/rij_shift
1647 fac=rij_shift**expon
1648 e1=fac*fac*aa(itypi,itypj)
1649 e2=fac*bb(itypi,itypj)
1650 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1651 eps2der=evdwij*eps3rt
1652 eps3der=evdwij*eps2rt
1653 fac_augm=rrij**expon
1654 e_augm=augm(itypi,itypj)*fac_augm
1655 evdwij=evdwij*eps2rt*eps3rt
1656 evdw=evdw+evdwij+e_augm
1658 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1659 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1660 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1661 & restyp(itypi),i,restyp(itypj),j,
1662 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1663 & chi1,chi2,chip1,chip2,
1664 & eps1,eps2rt**2,eps3rt**2,
1665 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1668 C Calculate gradient components.
1669 e1=e1*eps1*eps2rt**2*eps3rt**2
1670 fac=-expon*(e1+evdwij)*rij_shift
1672 fac=rij*fac-2*expon*rrij*e_augm
1673 C Calculate the radial part of the gradient
1677 C Calculate angular part of the gradient.
1683 C-----------------------------------------------------------------------------
1684 subroutine sc_angular
1685 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1686 C om12. Called by ebp, egb, and egbv.
1688 include 'COMMON.CALC'
1689 include 'COMMON.IOUNITS'
1693 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1694 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1695 om12=dxi*dxj+dyi*dyj+dzi*dzj
1697 C Calculate eps1(om12) and its derivative in om12
1698 faceps1=1.0D0-om12*chiom12
1699 faceps1_inv=1.0D0/faceps1
1700 eps1=dsqrt(faceps1_inv)
1701 C Following variable is eps1*deps1/dom12
1702 eps1_om12=faceps1_inv*chiom12
1707 c write (iout,*) "om12",om12," eps1",eps1
1708 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1713 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1714 sigsq=1.0D0-facsig*faceps1_inv
1715 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1716 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1717 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1723 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1724 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1726 C Calculate eps2 and its derivatives in om1, om2, and om12.
1729 chipom12=chip12*om12
1730 facp=1.0D0-om12*chipom12
1732 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1733 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1734 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1735 C Following variable is the square root of eps2
1736 eps2rt=1.0D0-facp1*facp_inv
1737 C Following three variables are the derivatives of the square root of eps
1738 C in om1, om2, and om12.
1739 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1740 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1741 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1742 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1743 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1744 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1745 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1746 c & " eps2rt_om12",eps2rt_om12
1747 C Calculate whole angle-dependent part of epsilon and contributions
1748 C to its derivatives
1751 C----------------------------------------------------------------------------
1753 implicit real*8 (a-h,o-z)
1754 include 'DIMENSIONS'
1755 include 'COMMON.CHAIN'
1756 include 'COMMON.DERIV'
1757 include 'COMMON.CALC'
1758 include 'COMMON.IOUNITS'
1759 double precision dcosom1(3),dcosom2(3)
1760 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1761 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1762 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1763 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1767 c eom12=evdwij*eps1_om12
1769 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1770 c & " sigder",sigder
1771 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1772 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1774 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1775 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1778 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1780 c write (iout,*) "gg",(gg(k),k=1,3)
1782 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1783 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1784 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1785 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1786 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1787 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1788 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1789 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1790 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1791 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1794 C Calculate the components of the gradient in DC and X
1798 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1802 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1803 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1807 C-----------------------------------------------------------------------
1808 subroutine e_softsphere(evdw)
1810 C This subroutine calculates the interaction energy of nonbonded side chains
1811 C assuming the LJ potential of interaction.
1813 implicit real*8 (a-h,o-z)
1814 include 'DIMENSIONS'
1815 parameter (accur=1.0d-10)
1816 include 'COMMON.GEO'
1817 include 'COMMON.VAR'
1818 include 'COMMON.LOCAL'
1819 include 'COMMON.CHAIN'
1820 include 'COMMON.DERIV'
1821 include 'COMMON.INTERACT'
1822 include 'COMMON.TORSION'
1823 include 'COMMON.SBRIDGE'
1824 include 'COMMON.NAMES'
1825 include 'COMMON.IOUNITS'
1826 include 'COMMON.CONTACTS'
1828 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1830 do i=iatsc_s,iatsc_e
1831 itypi=iabs(itype(i))
1832 if (itypi.eq.ntyp1) cycle
1833 itypi1=iabs(itype(i+1))
1838 C Calculate SC interaction energy.
1840 do iint=1,nint_gr(i)
1841 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1842 cd & 'iend=',iend(i,iint)
1843 do j=istart(i,iint),iend(i,iint)
1844 itypj=iabs(itype(j))
1845 if (itypj.eq.ntyp1) cycle
1849 rij=xj*xj+yj*yj+zj*zj
1850 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1851 r0ij=r0(itypi,itypj)
1853 c print *,i,j,r0ij,dsqrt(rij)
1854 if (rij.lt.r0ijsq) then
1855 evdwij=0.25d0*(rij-r0ijsq)**2
1863 C Calculate the components of the gradient in DC and X
1869 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1870 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1871 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1872 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1876 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1884 C--------------------------------------------------------------------------
1885 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1888 C Soft-sphere potential of p-p interaction
1890 implicit real*8 (a-h,o-z)
1891 include 'DIMENSIONS'
1892 include 'COMMON.CONTROL'
1893 include 'COMMON.IOUNITS'
1894 include 'COMMON.GEO'
1895 include 'COMMON.VAR'
1896 include 'COMMON.LOCAL'
1897 include 'COMMON.CHAIN'
1898 include 'COMMON.DERIV'
1899 include 'COMMON.INTERACT'
1900 include 'COMMON.CONTACTS'
1901 include 'COMMON.TORSION'
1902 include 'COMMON.VECTORS'
1903 include 'COMMON.FFIELD'
1905 cd write(iout,*) 'In EELEC_soft_sphere'
1912 do i=iatel_s,iatel_e
1913 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1917 xmedi=c(1,i)+0.5d0*dxi
1918 ymedi=c(2,i)+0.5d0*dyi
1919 zmedi=c(3,i)+0.5d0*dzi
1921 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1922 do j=ielstart(i),ielend(i)
1923 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1927 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1928 r0ij=rpp(iteli,itelj)
1933 xj=c(1,j)+0.5D0*dxj-xmedi
1934 yj=c(2,j)+0.5D0*dyj-ymedi
1935 zj=c(3,j)+0.5D0*dzj-zmedi
1936 rij=xj*xj+yj*yj+zj*zj
1937 if (rij.lt.r0ijsq) then
1938 evdw1ij=0.25d0*(rij-r0ijsq)**2
1946 C Calculate contributions to the Cartesian gradient.
1952 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1953 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1956 * Loop over residues i+1 thru j-1.
1960 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
1965 cgrad do i=nnt,nct-1
1967 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1969 cgrad do j=i+1,nct-1
1971 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
1977 c------------------------------------------------------------------------------
1978 subroutine vec_and_deriv
1979 implicit real*8 (a-h,o-z)
1980 include 'DIMENSIONS'
1984 include 'COMMON.IOUNITS'
1985 include 'COMMON.GEO'
1986 include 'COMMON.VAR'
1987 include 'COMMON.LOCAL'
1988 include 'COMMON.CHAIN'
1989 include 'COMMON.VECTORS'
1990 include 'COMMON.SETUP'
1991 include 'COMMON.TIME1'
1992 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1993 C Compute the local reference systems. For reference system (i), the
1994 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1995 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1997 do i=ivec_start,ivec_end
2001 if (i.eq.nres-1) then
2002 C Case of the last full residue
2003 C Compute the Z-axis
2004 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2005 costh=dcos(pi-theta(nres))
2006 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2010 C Compute the derivatives of uz
2012 uzder(2,1,1)=-dc_norm(3,i-1)
2013 uzder(3,1,1)= dc_norm(2,i-1)
2014 uzder(1,2,1)= dc_norm(3,i-1)
2016 uzder(3,2,1)=-dc_norm(1,i-1)
2017 uzder(1,3,1)=-dc_norm(2,i-1)
2018 uzder(2,3,1)= dc_norm(1,i-1)
2021 uzder(2,1,2)= dc_norm(3,i)
2022 uzder(3,1,2)=-dc_norm(2,i)
2023 uzder(1,2,2)=-dc_norm(3,i)
2025 uzder(3,2,2)= dc_norm(1,i)
2026 uzder(1,3,2)= dc_norm(2,i)
2027 uzder(2,3,2)=-dc_norm(1,i)
2029 C Compute the Y-axis
2032 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2034 C Compute the derivatives of uy
2037 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2038 & -dc_norm(k,i)*dc_norm(j,i-1)
2039 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2041 uyder(j,j,1)=uyder(j,j,1)-costh
2042 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2047 uygrad(l,k,j,i)=uyder(l,k,j)
2048 uzgrad(l,k,j,i)=uzder(l,k,j)
2052 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2053 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2054 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2055 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2058 C Compute the Z-axis
2059 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2060 costh=dcos(pi-theta(i+2))
2061 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2065 C Compute the derivatives of uz
2067 uzder(2,1,1)=-dc_norm(3,i+1)
2068 uzder(3,1,1)= dc_norm(2,i+1)
2069 uzder(1,2,1)= dc_norm(3,i+1)
2071 uzder(3,2,1)=-dc_norm(1,i+1)
2072 uzder(1,3,1)=-dc_norm(2,i+1)
2073 uzder(2,3,1)= dc_norm(1,i+1)
2076 uzder(2,1,2)= dc_norm(3,i)
2077 uzder(3,1,2)=-dc_norm(2,i)
2078 uzder(1,2,2)=-dc_norm(3,i)
2080 uzder(3,2,2)= dc_norm(1,i)
2081 uzder(1,3,2)= dc_norm(2,i)
2082 uzder(2,3,2)=-dc_norm(1,i)
2084 C Compute the Y-axis
2087 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2089 C Compute the derivatives of uy
2092 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2093 & -dc_norm(k,i)*dc_norm(j,i+1)
2094 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2096 uyder(j,j,1)=uyder(j,j,1)-costh
2097 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2102 uygrad(l,k,j,i)=uyder(l,k,j)
2103 uzgrad(l,k,j,i)=uzder(l,k,j)
2107 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2108 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2109 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2110 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2114 vbld_inv_temp(1)=vbld_inv(i+1)
2115 if (i.lt.nres-1) then
2116 vbld_inv_temp(2)=vbld_inv(i+2)
2118 vbld_inv_temp(2)=vbld_inv(i)
2123 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2124 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2129 #if defined(PARVEC) && defined(MPI)
2130 if (nfgtasks1.gt.1) then
2132 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2133 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2134 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2135 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2136 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2138 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2139 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2141 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2142 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2143 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2144 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2145 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2146 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2147 time_gather=time_gather+MPI_Wtime()-time00
2149 c if (fg_rank.eq.0) then
2150 c write (iout,*) "Arrays UY and UZ"
2152 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2159 C-----------------------------------------------------------------------------
2160 subroutine check_vecgrad
2161 implicit real*8 (a-h,o-z)
2162 include 'DIMENSIONS'
2163 include 'COMMON.IOUNITS'
2164 include 'COMMON.GEO'
2165 include 'COMMON.VAR'
2166 include 'COMMON.LOCAL'
2167 include 'COMMON.CHAIN'
2168 include 'COMMON.VECTORS'
2169 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2170 dimension uyt(3,maxres),uzt(3,maxres)
2171 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2172 double precision delta /1.0d-7/
2175 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2176 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2177 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2178 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2179 cd & (dc_norm(if90,i),if90=1,3)
2180 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2181 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2182 cd write(iout,'(a)')
2188 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2189 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2202 cd write (iout,*) 'i=',i
2204 erij(k)=dc_norm(k,i)
2208 dc_norm(k,i)=erij(k)
2210 dc_norm(j,i)=dc_norm(j,i)+delta
2211 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2213 c dc_norm(k,i)=dc_norm(k,i)/fac
2215 c write (iout,*) (dc_norm(k,i),k=1,3)
2216 c write (iout,*) (erij(k),k=1,3)
2219 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2220 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2221 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2222 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2224 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2225 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2226 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2229 dc_norm(k,i)=erij(k)
2232 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2233 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2234 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2235 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2236 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2237 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2238 cd write (iout,'(a)')
2243 C--------------------------------------------------------------------------
2244 subroutine set_matrices
2245 implicit real*8 (a-h,o-z)
2246 include 'DIMENSIONS'
2249 include "COMMON.SETUP"
2251 integer status(MPI_STATUS_SIZE)
2253 include 'COMMON.IOUNITS'
2254 include 'COMMON.GEO'
2255 include 'COMMON.VAR'
2256 include 'COMMON.LOCAL'
2257 include 'COMMON.CHAIN'
2258 include 'COMMON.DERIV'
2259 include 'COMMON.INTERACT'
2260 include 'COMMON.CONTACTS'
2261 include 'COMMON.TORSION'
2262 include 'COMMON.VECTORS'
2263 include 'COMMON.FFIELD'
2264 double precision auxvec(2),auxmat(2,2)
2266 C Compute the virtual-bond-torsional-angle dependent quantities needed
2267 C to calculate the el-loc multibody terms of various order.
2270 do i=ivec_start+2,ivec_end+2
2274 if (i .lt. nres+1) then
2311 if (i .gt. 3 .and. i .lt. nres+1) then
2312 obrot_der(1,i-2)=-sin1
2313 obrot_der(2,i-2)= cos1
2314 Ugder(1,1,i-2)= sin1
2315 Ugder(1,2,i-2)=-cos1
2316 Ugder(2,1,i-2)=-cos1
2317 Ugder(2,2,i-2)=-sin1
2320 obrot2_der(1,i-2)=-dwasin2
2321 obrot2_der(2,i-2)= dwacos2
2322 Ug2der(1,1,i-2)= dwasin2
2323 Ug2der(1,2,i-2)=-dwacos2
2324 Ug2der(2,1,i-2)=-dwacos2
2325 Ug2der(2,2,i-2)=-dwasin2
2327 obrot_der(1,i-2)=0.0d0
2328 obrot_der(2,i-2)=0.0d0
2329 Ugder(1,1,i-2)=0.0d0
2330 Ugder(1,2,i-2)=0.0d0
2331 Ugder(2,1,i-2)=0.0d0
2332 Ugder(2,2,i-2)=0.0d0
2333 obrot2_der(1,i-2)=0.0d0
2334 obrot2_der(2,i-2)=0.0d0
2335 Ug2der(1,1,i-2)=0.0d0
2336 Ug2der(1,2,i-2)=0.0d0
2337 Ug2der(2,1,i-2)=0.0d0
2338 Ug2der(2,2,i-2)=0.0d0
2340 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2341 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2342 iti = itortyp(itype(i-2))
2346 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2347 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2348 iti1 = itortyp(itype(i-1))
2352 cd write (iout,*) '*******i',i,' iti1',iti
2353 cd write (iout,*) 'b1',b1(:,iti)
2354 cd write (iout,*) 'b2',b2(:,iti)
2355 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2356 c if (i .gt. iatel_s+2) then
2357 if (i .gt. nnt+2) then
2358 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2359 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2360 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2362 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2363 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2364 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2365 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2366 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2377 DtUg2(l,k,i-2)=0.0d0
2381 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2382 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2384 muder(k,i-2)=Ub2der(k,i-2)
2386 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2387 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2388 if (itype(i-1).le.ntyp) then
2389 iti1 = itortyp(itype(i-1))
2397 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2399 cd write (iout,*) 'mu ',mu(:,i-2)
2400 cd write (iout,*) 'mu1',mu1(:,i-2)
2401 cd write (iout,*) 'mu2',mu2(:,i-2)
2402 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2404 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2405 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2406 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2407 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2408 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2409 C Vectors and matrices dependent on a single virtual-bond dihedral.
2410 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2411 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2412 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2413 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2414 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2415 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2416 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2417 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2418 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2421 C Matrices dependent on two consecutive virtual-bond dihedrals.
2422 C The order of matrices is from left to right.
2423 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2425 c do i=max0(ivec_start,2),ivec_end
2427 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2428 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2429 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2430 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2431 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2432 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2433 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2434 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2437 #if defined(MPI) && defined(PARMAT)
2439 c if (fg_rank.eq.0) then
2440 write (iout,*) "Arrays UG and UGDER before GATHER"
2442 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2443 & ((ug(l,k,i),l=1,2),k=1,2),
2444 & ((ugder(l,k,i),l=1,2),k=1,2)
2446 write (iout,*) "Arrays UG2 and UG2DER"
2448 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2449 & ((ug2(l,k,i),l=1,2),k=1,2),
2450 & ((ug2der(l,k,i),l=1,2),k=1,2)
2452 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2454 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2455 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2456 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2458 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2460 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2461 & costab(i),sintab(i),costab2(i),sintab2(i)
2463 write (iout,*) "Array MUDER"
2465 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2469 if (nfgtasks.gt.1) then
2471 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2472 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2473 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2475 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2476 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2478 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2479 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2481 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2482 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2484 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2485 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2487 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2488 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2490 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2491 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2493 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2494 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2495 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2496 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2497 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2498 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2499 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2500 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2501 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2502 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2503 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2504 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2505 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2507 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2508 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2510 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2511 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2513 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2514 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2516 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2517 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2519 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2520 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2522 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2523 & ivec_count(fg_rank1),
2524 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2526 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2527 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2529 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2530 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2532 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2533 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2535 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2536 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2538 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2539 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2541 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2542 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2544 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2545 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2547 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2548 & ivec_count(fg_rank1),
2549 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2551 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2552 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2554 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2555 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2557 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2558 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2560 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2561 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2563 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2564 & ivec_count(fg_rank1),
2565 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2567 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2568 & ivec_count(fg_rank1),
2569 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2571 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2572 & ivec_count(fg_rank1),
2573 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2574 & MPI_MAT2,FG_COMM1,IERR)
2575 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2576 & ivec_count(fg_rank1),
2577 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2578 & MPI_MAT2,FG_COMM1,IERR)
2581 c Passes matrix info through the ring
2584 if (irecv.lt.0) irecv=nfgtasks1-1
2587 if (inext.ge.nfgtasks1) inext=0
2589 c write (iout,*) "isend",isend," irecv",irecv
2591 lensend=lentyp(isend)
2592 lenrecv=lentyp(irecv)
2593 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2594 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2595 c & MPI_ROTAT1(lensend),inext,2200+isend,
2596 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2597 c & iprev,2200+irecv,FG_COMM,status,IERR)
2598 c write (iout,*) "Gather ROTAT1"
2600 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2601 c & MPI_ROTAT2(lensend),inext,3300+isend,
2602 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2603 c & iprev,3300+irecv,FG_COMM,status,IERR)
2604 c write (iout,*) "Gather ROTAT2"
2606 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2607 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2608 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2609 & iprev,4400+irecv,FG_COMM,status,IERR)
2610 c write (iout,*) "Gather ROTAT_OLD"
2612 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2613 & MPI_PRECOMP11(lensend),inext,5500+isend,
2614 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2615 & iprev,5500+irecv,FG_COMM,status,IERR)
2616 c write (iout,*) "Gather PRECOMP11"
2618 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2619 & MPI_PRECOMP12(lensend),inext,6600+isend,
2620 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2621 & iprev,6600+irecv,FG_COMM,status,IERR)
2622 c write (iout,*) "Gather PRECOMP12"
2624 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2626 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2627 & MPI_ROTAT2(lensend),inext,7700+isend,
2628 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2629 & iprev,7700+irecv,FG_COMM,status,IERR)
2630 c write (iout,*) "Gather PRECOMP21"
2632 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2633 & MPI_PRECOMP22(lensend),inext,8800+isend,
2634 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2635 & iprev,8800+irecv,FG_COMM,status,IERR)
2636 c write (iout,*) "Gather PRECOMP22"
2638 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2639 & MPI_PRECOMP23(lensend),inext,9900+isend,
2640 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2641 & MPI_PRECOMP23(lenrecv),
2642 & iprev,9900+irecv,FG_COMM,status,IERR)
2643 c write (iout,*) "Gather PRECOMP23"
2648 if (irecv.lt.0) irecv=nfgtasks1-1
2651 time_gather=time_gather+MPI_Wtime()-time00
2654 c if (fg_rank.eq.0) then
2655 write (iout,*) "Arrays UG and UGDER"
2657 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2658 & ((ug(l,k,i),l=1,2),k=1,2),
2659 & ((ugder(l,k,i),l=1,2),k=1,2)
2661 write (iout,*) "Arrays UG2 and UG2DER"
2663 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2664 & ((ug2(l,k,i),l=1,2),k=1,2),
2665 & ((ug2der(l,k,i),l=1,2),k=1,2)
2667 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2669 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2670 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2671 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2673 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2675 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2676 & costab(i),sintab(i),costab2(i),sintab2(i)
2678 write (iout,*) "Array MUDER"
2680 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2686 cd iti = itortyp(itype(i))
2689 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2690 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2695 C--------------------------------------------------------------------------
2696 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2698 C This subroutine calculates the average interaction energy and its gradient
2699 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2700 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2701 C The potential depends both on the distance of peptide-group centers and on
2702 C the orientation of the CA-CA virtual bonds.
2704 implicit real*8 (a-h,o-z)
2708 include 'DIMENSIONS'
2709 include 'COMMON.CONTROL'
2710 include 'COMMON.SETUP'
2711 include 'COMMON.IOUNITS'
2712 include 'COMMON.GEO'
2713 include 'COMMON.VAR'
2714 include 'COMMON.LOCAL'
2715 include 'COMMON.CHAIN'
2716 include 'COMMON.DERIV'
2717 include 'COMMON.INTERACT'
2718 include 'COMMON.CONTACTS'
2719 include 'COMMON.TORSION'
2720 include 'COMMON.VECTORS'
2721 include 'COMMON.FFIELD'
2722 include 'COMMON.TIME1'
2723 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2724 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2725 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2726 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2727 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2728 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2730 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2732 double precision scal_el /1.0d0/
2734 double precision scal_el /0.5d0/
2737 C 13-go grudnia roku pamietnego...
2738 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2739 & 0.0d0,1.0d0,0.0d0,
2740 & 0.0d0,0.0d0,1.0d0/
2741 cd write(iout,*) 'In EELEC'
2743 cd write(iout,*) 'Type',i
2744 cd write(iout,*) 'B1',B1(:,i)
2745 cd write(iout,*) 'B2',B2(:,i)
2746 cd write(iout,*) 'CC',CC(:,:,i)
2747 cd write(iout,*) 'DD',DD(:,:,i)
2748 cd write(iout,*) 'EE',EE(:,:,i)
2750 cd call check_vecgrad
2752 if (icheckgrad.eq.1) then
2754 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2756 dc_norm(k,i)=dc(k,i)*fac
2758 c write (iout,*) 'i',i,' fac',fac
2761 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2762 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2763 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2764 c call vec_and_deriv
2770 time_mat=time_mat+MPI_Wtime()-time01
2774 cd write (iout,*) 'i=',i
2776 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2779 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2780 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2793 cd print '(a)','Enter EELEC'
2794 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2796 gel_loc_loc(i)=0.0d0
2801 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2803 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2805 do i=iturn3_start,iturn3_end
2806 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2807 & .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
2811 dx_normi=dc_norm(1,i)
2812 dy_normi=dc_norm(2,i)
2813 dz_normi=dc_norm(3,i)
2814 xmedi=c(1,i)+0.5d0*dxi
2815 ymedi=c(2,i)+0.5d0*dyi
2816 zmedi=c(3,i)+0.5d0*dzi
2818 call eelecij(i,i+2,ees,evdw1,eel_loc)
2819 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2820 num_cont_hb(i)=num_conti
2822 do i=iturn4_start,iturn4_end
2823 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2824 & .or. itype(i+3).eq.ntyp1
2825 & .or. itype(i+4).eq.ntyp1) cycle
2829 dx_normi=dc_norm(1,i)
2830 dy_normi=dc_norm(2,i)
2831 dz_normi=dc_norm(3,i)
2832 xmedi=c(1,i)+0.5d0*dxi
2833 ymedi=c(2,i)+0.5d0*dyi
2834 zmedi=c(3,i)+0.5d0*dzi
2835 num_conti=num_cont_hb(i)
2836 call eelecij(i,i+3,ees,evdw1,eel_loc)
2837 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2838 & call eturn4(i,eello_turn4)
2839 num_cont_hb(i)=num_conti
2842 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2844 do i=iatel_s,iatel_e
2845 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2849 dx_normi=dc_norm(1,i)
2850 dy_normi=dc_norm(2,i)
2851 dz_normi=dc_norm(3,i)
2852 xmedi=c(1,i)+0.5d0*dxi
2853 ymedi=c(2,i)+0.5d0*dyi
2854 zmedi=c(3,i)+0.5d0*dzi
2855 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2856 num_conti=num_cont_hb(i)
2857 do j=ielstart(i),ielend(i)
2858 c write (iout,*) i,j,itype(i),itype(j)
2859 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2860 call eelecij(i,j,ees,evdw1,eel_loc)
2862 num_cont_hb(i)=num_conti
2864 c write (iout,*) "Number of loop steps in EELEC:",ind
2866 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2867 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2869 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2870 ccc eel_loc=eel_loc+eello_turn3
2871 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2874 C-------------------------------------------------------------------------------
2875 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2876 implicit real*8 (a-h,o-z)
2877 include 'DIMENSIONS'
2881 include 'COMMON.CONTROL'
2882 include 'COMMON.IOUNITS'
2883 include 'COMMON.GEO'
2884 include 'COMMON.VAR'
2885 include 'COMMON.LOCAL'
2886 include 'COMMON.CHAIN'
2887 include 'COMMON.DERIV'
2888 include 'COMMON.INTERACT'
2889 include 'COMMON.CONTACTS'
2890 include 'COMMON.TORSION'
2891 include 'COMMON.VECTORS'
2892 include 'COMMON.FFIELD'
2893 include 'COMMON.TIME1'
2894 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2895 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2896 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2897 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2898 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2899 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2901 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2903 double precision scal_el /1.0d0/
2905 double precision scal_el /0.5d0/
2908 C 13-go grudnia roku pamietnego...
2909 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2910 & 0.0d0,1.0d0,0.0d0,
2911 & 0.0d0,0.0d0,1.0d0/
2912 c time00=MPI_Wtime()
2913 cd write (iout,*) "eelecij",i,j
2917 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2918 aaa=app(iteli,itelj)
2919 bbb=bpp(iteli,itelj)
2920 ael6i=ael6(iteli,itelj)
2921 ael3i=ael3(iteli,itelj)
2925 dx_normj=dc_norm(1,j)
2926 dy_normj=dc_norm(2,j)
2927 dz_normj=dc_norm(3,j)
2928 xj=c(1,j)+0.5D0*dxj-xmedi
2929 yj=c(2,j)+0.5D0*dyj-ymedi
2930 zj=c(3,j)+0.5D0*dzj-zmedi
2931 rij=xj*xj+yj*yj+zj*zj
2937 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2938 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2939 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2940 fac=cosa-3.0D0*cosb*cosg
2942 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2943 if (j.eq.i+2) ev1=scal_el*ev1
2948 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2951 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2952 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2955 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2956 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2957 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2958 cd & xmedi,ymedi,zmedi,xj,yj,zj
2960 if (energy_dec) then
2961 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
2963 &,iteli,itelj,aaa,evdw1
2964 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2968 C Calculate contributions to the Cartesian gradient.
2971 facvdw=-6*rrmij*(ev1+evdwij)
2972 facel=-3*rrmij*(el1+eesij)
2978 * Radial derivatives. First process both termini of the fragment (i,j)
2984 c ghalf=0.5D0*ggg(k)
2985 c gelc(k,i)=gelc(k,i)+ghalf
2986 c gelc(k,j)=gelc(k,j)+ghalf
2988 c 9/28/08 AL Gradient compotents will be summed only at the end
2990 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2991 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2994 * Loop over residues i+1 thru j-1.
2998 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3005 c ghalf=0.5D0*ggg(k)
3006 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3007 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3009 c 9/28/08 AL Gradient compotents will be summed only at the end
3011 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3012 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3015 * Loop over residues i+1 thru j-1.
3019 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3026 fac=-3*rrmij*(facvdw+facvdw+facel)
3031 * Radial derivatives. First process both termini of the fragment (i,j)
3037 c ghalf=0.5D0*ggg(k)
3038 c gelc(k,i)=gelc(k,i)+ghalf
3039 c gelc(k,j)=gelc(k,j)+ghalf
3041 c 9/28/08 AL Gradient compotents will be summed only at the end
3043 gelc_long(k,j)=gelc(k,j)+ggg(k)
3044 gelc_long(k,i)=gelc(k,i)-ggg(k)
3047 * Loop over residues i+1 thru j-1.
3051 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3054 c 9/28/08 AL Gradient compotents will be summed only at the end
3059 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3060 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3066 ecosa=2.0D0*fac3*fac1+fac4
3069 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3070 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3072 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3073 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3075 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3076 cd & (dcosg(k),k=1,3)
3078 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3081 c ghalf=0.5D0*ggg(k)
3082 c gelc(k,i)=gelc(k,i)+ghalf
3083 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3084 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3085 c gelc(k,j)=gelc(k,j)+ghalf
3086 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3087 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3091 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3096 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3097 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3099 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3100 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3101 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3102 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3104 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3105 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3106 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3108 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3109 C energy of a peptide unit is assumed in the form of a second-order
3110 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3111 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3112 C are computed for EVERY pair of non-contiguous peptide groups.
3114 if (j.lt.nres-1) then
3125 muij(kkk)=mu(k,i)*mu(l,j)
3128 cd write (iout,*) 'EELEC: i',i,' j',j
3129 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3130 cd write(iout,*) 'muij',muij
3131 ury=scalar(uy(1,i),erij)
3132 urz=scalar(uz(1,i),erij)
3133 vry=scalar(uy(1,j),erij)
3134 vrz=scalar(uz(1,j),erij)
3135 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3136 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3137 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3138 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3139 fac=dsqrt(-ael6i)*r3ij
3144 cd write (iout,'(4i5,4f10.5)')
3145 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3146 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3147 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3148 cd & uy(:,j),uz(:,j)
3149 cd write (iout,'(4f10.5)')
3150 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3151 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3152 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3153 cd write (iout,'(9f10.5/)')
3154 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3155 C Derivatives of the elements of A in virtual-bond vectors
3156 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3158 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3159 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3160 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3161 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3162 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3163 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3164 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3165 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3166 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3167 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3168 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3169 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3171 C Compute radial contributions to the gradient
3189 C Add the contributions coming from er
3192 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3193 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3194 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3195 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3198 C Derivatives in DC(i)
3199 cgrad ghalf1=0.5d0*agg(k,1)
3200 cgrad ghalf2=0.5d0*agg(k,2)
3201 cgrad ghalf3=0.5d0*agg(k,3)
3202 cgrad ghalf4=0.5d0*agg(k,4)
3203 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3204 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3205 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3206 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3207 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3208 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3209 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3210 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3211 C Derivatives in DC(i+1)
3212 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3213 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3214 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3215 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3216 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3217 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3218 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3219 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3220 C Derivatives in DC(j)
3221 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3222 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3223 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3224 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3225 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3226 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3227 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3228 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3229 C Derivatives in DC(j+1) or DC(nres-1)
3230 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3231 & -3.0d0*vryg(k,3)*ury)
3232 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3233 & -3.0d0*vrzg(k,3)*ury)
3234 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3235 & -3.0d0*vryg(k,3)*urz)
3236 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3237 & -3.0d0*vrzg(k,3)*urz)
3238 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3240 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3253 aggi(k,l)=-aggi(k,l)
3254 aggi1(k,l)=-aggi1(k,l)
3255 aggj(k,l)=-aggj(k,l)
3256 aggj1(k,l)=-aggj1(k,l)
3259 if (j.lt.nres-1) then
3265 aggi(k,l)=-aggi(k,l)
3266 aggi1(k,l)=-aggi1(k,l)
3267 aggj(k,l)=-aggj(k,l)
3268 aggj1(k,l)=-aggj1(k,l)
3279 aggi(k,l)=-aggi(k,l)
3280 aggi1(k,l)=-aggi1(k,l)
3281 aggj(k,l)=-aggj(k,l)
3282 aggj1(k,l)=-aggj1(k,l)
3287 IF (wel_loc.gt.0.0d0) THEN
3288 C Contribution to the local-electrostatic energy coming from the i-j pair
3289 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3291 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3293 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3294 & 'eelloc',i,j,eel_loc_ij
3295 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3297 eel_loc=eel_loc+eel_loc_ij
3298 C Partial derivatives in virtual-bond dihedral angles gamma
3300 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3301 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3302 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3303 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3304 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3305 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3306 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3308 ggg(l)=agg(l,1)*muij(1)+
3309 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3310 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3311 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3312 cgrad ghalf=0.5d0*ggg(l)
3313 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3314 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3318 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3321 C Remaining derivatives of eello
3323 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3324 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3325 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3326 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3327 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3328 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3329 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3330 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3333 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3334 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3335 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3336 & .and. num_conti.le.maxconts) then
3337 c write (iout,*) i,j," entered corr"
3339 C Calculate the contact function. The ith column of the array JCONT will
3340 C contain the numbers of atoms that make contacts with the atom I (of numbers
3341 C greater than I). The arrays FACONT and GACONT will contain the values of
3342 C the contact function and its derivative.
3343 c r0ij=1.02D0*rpp(iteli,itelj)
3344 c r0ij=1.11D0*rpp(iteli,itelj)
3345 r0ij=2.20D0*rpp(iteli,itelj)
3346 c r0ij=1.55D0*rpp(iteli,itelj)
3347 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3348 if (fcont.gt.0.0D0) then
3349 num_conti=num_conti+1
3350 if (num_conti.gt.maxconts) then
3351 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3352 & ' will skip next contacts for this conf.'
3354 jcont_hb(num_conti,i)=j
3355 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3356 cd & " jcont_hb",jcont_hb(num_conti,i)
3357 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3358 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3359 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3361 d_cont(num_conti,i)=rij
3362 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3363 C --- Electrostatic-interaction matrix ---
3364 a_chuj(1,1,num_conti,i)=a22
3365 a_chuj(1,2,num_conti,i)=a23
3366 a_chuj(2,1,num_conti,i)=a32
3367 a_chuj(2,2,num_conti,i)=a33
3368 C --- Gradient of rij
3370 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3377 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3378 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3379 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3380 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3381 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3386 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3387 C Calculate contact energies
3389 wij=cosa-3.0D0*cosb*cosg
3392 c fac3=dsqrt(-ael6i)/r0ij**3
3393 fac3=dsqrt(-ael6i)*r3ij
3394 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3395 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3396 if (ees0tmp.gt.0) then
3397 ees0pij=dsqrt(ees0tmp)
3401 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3402 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3403 if (ees0tmp.gt.0) then
3404 ees0mij=dsqrt(ees0tmp)
3409 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3410 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3411 C Diagnostics. Comment out or remove after debugging!
3412 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3413 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3414 c ees0m(num_conti,i)=0.0D0
3416 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3417 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3418 C Angular derivatives of the contact function
3419 ees0pij1=fac3/ees0pij
3420 ees0mij1=fac3/ees0mij
3421 fac3p=-3.0D0*fac3*rrmij
3422 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3423 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3425 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3426 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3427 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3428 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3429 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3430 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3431 ecosap=ecosa1+ecosa2
3432 ecosbp=ecosb1+ecosb2
3433 ecosgp=ecosg1+ecosg2
3434 ecosam=ecosa1-ecosa2
3435 ecosbm=ecosb1-ecosb2
3436 ecosgm=ecosg1-ecosg2
3445 facont_hb(num_conti,i)=fcont
3446 fprimcont=fprimcont/rij
3447 cd facont_hb(num_conti,i)=1.0D0
3448 C Following line is for diagnostics.
3451 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3452 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3455 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3456 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3458 gggp(1)=gggp(1)+ees0pijp*xj
3459 gggp(2)=gggp(2)+ees0pijp*yj
3460 gggp(3)=gggp(3)+ees0pijp*zj
3461 gggm(1)=gggm(1)+ees0mijp*xj
3462 gggm(2)=gggm(2)+ees0mijp*yj
3463 gggm(3)=gggm(3)+ees0mijp*zj
3464 C Derivatives due to the contact function
3465 gacont_hbr(1,num_conti,i)=fprimcont*xj
3466 gacont_hbr(2,num_conti,i)=fprimcont*yj
3467 gacont_hbr(3,num_conti,i)=fprimcont*zj
3470 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3471 c following the change of gradient-summation algorithm.
3473 cgrad ghalfp=0.5D0*gggp(k)
3474 cgrad ghalfm=0.5D0*gggm(k)
3475 gacontp_hb1(k,num_conti,i)=!ghalfp
3476 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3477 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3478 gacontp_hb2(k,num_conti,i)=!ghalfp
3479 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3480 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3481 gacontp_hb3(k,num_conti,i)=gggp(k)
3482 gacontm_hb1(k,num_conti,i)=!ghalfm
3483 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3484 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3485 gacontm_hb2(k,num_conti,i)=!ghalfm
3486 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3487 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3488 gacontm_hb3(k,num_conti,i)=gggm(k)
3490 C Diagnostics. Comment out or remove after debugging!
3492 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3493 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3494 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3495 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3496 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3497 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3500 endif ! num_conti.le.maxconts
3503 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3506 ghalf=0.5d0*agg(l,k)
3507 aggi(l,k)=aggi(l,k)+ghalf
3508 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3509 aggj(l,k)=aggj(l,k)+ghalf
3512 if (j.eq.nres-1 .and. i.lt.j-2) then
3515 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3520 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3523 C-----------------------------------------------------------------------------
3524 subroutine eturn3(i,eello_turn3)
3525 C Third- and fourth-order contributions from turns
3526 implicit real*8 (a-h,o-z)
3527 include 'DIMENSIONS'
3528 include 'COMMON.IOUNITS'
3529 include 'COMMON.GEO'
3530 include 'COMMON.VAR'
3531 include 'COMMON.LOCAL'
3532 include 'COMMON.CHAIN'
3533 include 'COMMON.DERIV'
3534 include 'COMMON.INTERACT'
3535 include 'COMMON.CONTACTS'
3536 include 'COMMON.TORSION'
3537 include 'COMMON.VECTORS'
3538 include 'COMMON.FFIELD'
3539 include 'COMMON.CONTROL'
3541 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3542 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3543 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3544 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3545 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3546 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3547 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3550 c write (iout,*) "eturn3",i,j,j1,j2
3555 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3557 C Third-order contributions
3564 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3565 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3566 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3567 call transpose2(auxmat(1,1),auxmat1(1,1))
3568 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3569 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3570 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3571 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3572 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3573 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3574 cd & ' eello_turn3_num',4*eello_turn3_num
3575 C Derivatives in gamma(i)
3576 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3577 call transpose2(auxmat2(1,1),auxmat3(1,1))
3578 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3579 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3580 C Derivatives in gamma(i+1)
3581 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3582 call transpose2(auxmat2(1,1),auxmat3(1,1))
3583 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3584 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3585 & +0.5d0*(pizda(1,1)+pizda(2,2))
3586 C Cartesian derivatives
3588 c ghalf1=0.5d0*agg(l,1)
3589 c ghalf2=0.5d0*agg(l,2)
3590 c ghalf3=0.5d0*agg(l,3)
3591 c ghalf4=0.5d0*agg(l,4)
3592 a_temp(1,1)=aggi(l,1)!+ghalf1
3593 a_temp(1,2)=aggi(l,2)!+ghalf2
3594 a_temp(2,1)=aggi(l,3)!+ghalf3
3595 a_temp(2,2)=aggi(l,4)!+ghalf4
3596 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3597 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3598 & +0.5d0*(pizda(1,1)+pizda(2,2))
3599 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3600 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3601 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3602 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3603 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3604 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3605 & +0.5d0*(pizda(1,1)+pizda(2,2))
3606 a_temp(1,1)=aggj(l,1)!+ghalf1
3607 a_temp(1,2)=aggj(l,2)!+ghalf2
3608 a_temp(2,1)=aggj(l,3)!+ghalf3
3609 a_temp(2,2)=aggj(l,4)!+ghalf4
3610 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3611 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3612 & +0.5d0*(pizda(1,1)+pizda(2,2))
3613 a_temp(1,1)=aggj1(l,1)
3614 a_temp(1,2)=aggj1(l,2)
3615 a_temp(2,1)=aggj1(l,3)
3616 a_temp(2,2)=aggj1(l,4)
3617 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3618 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3619 & +0.5d0*(pizda(1,1)+pizda(2,2))
3623 C-------------------------------------------------------------------------------
3624 subroutine eturn4(i,eello_turn4)
3625 C Third- and fourth-order contributions from turns
3626 implicit real*8 (a-h,o-z)
3627 include 'DIMENSIONS'
3628 include 'COMMON.IOUNITS'
3629 include 'COMMON.GEO'
3630 include 'COMMON.VAR'
3631 include 'COMMON.LOCAL'
3632 include 'COMMON.CHAIN'
3633 include 'COMMON.DERIV'
3634 include 'COMMON.INTERACT'
3635 include 'COMMON.CONTACTS'
3636 include 'COMMON.TORSION'
3637 include 'COMMON.VECTORS'
3638 include 'COMMON.FFIELD'
3639 include 'COMMON.CONTROL'
3641 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3642 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3643 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3644 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3645 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3646 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3647 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3650 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3652 C Fourth-order contributions
3660 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3661 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3662 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3667 iti1=itortyp(itype(i+1))
3668 iti2=itortyp(itype(i+2))
3669 iti3=itortyp(itype(i+3))
3670 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3671 call transpose2(EUg(1,1,i+1),e1t(1,1))
3672 call transpose2(Eug(1,1,i+2),e2t(1,1))
3673 call transpose2(Eug(1,1,i+3),e3t(1,1))
3674 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3675 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3676 s1=scalar2(b1(1,iti2),auxvec(1))
3677 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3678 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3679 s2=scalar2(b1(1,iti1),auxvec(1))
3680 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3681 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3682 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3683 eello_turn4=eello_turn4-(s1+s2+s3)
3684 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3685 & 'eturn4',i,j,-(s1+s2+s3)
3686 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3687 cd & ' eello_turn4_num',8*eello_turn4_num
3688 C Derivatives in gamma(i)
3689 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3690 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3691 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3692 s1=scalar2(b1(1,iti2),auxvec(1))
3693 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3694 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3695 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3696 C Derivatives in gamma(i+1)
3697 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3698 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3699 s2=scalar2(b1(1,iti1),auxvec(1))
3700 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3701 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3702 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3703 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3704 C Derivatives in gamma(i+2)
3705 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3706 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3707 s1=scalar2(b1(1,iti2),auxvec(1))
3708 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3709 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3710 s2=scalar2(b1(1,iti1),auxvec(1))
3711 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3712 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3713 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3714 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3715 C Cartesian derivatives
3716 C Derivatives of this turn contributions in DC(i+2)
3717 if (j.lt.nres-1) then
3719 a_temp(1,1)=agg(l,1)
3720 a_temp(1,2)=agg(l,2)
3721 a_temp(2,1)=agg(l,3)
3722 a_temp(2,2)=agg(l,4)
3723 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3724 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3725 s1=scalar2(b1(1,iti2),auxvec(1))
3726 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3727 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3728 s2=scalar2(b1(1,iti1),auxvec(1))
3729 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3730 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3731 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3733 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3736 C Remaining derivatives of this turn contribution
3738 a_temp(1,1)=aggi(l,1)
3739 a_temp(1,2)=aggi(l,2)
3740 a_temp(2,1)=aggi(l,3)
3741 a_temp(2,2)=aggi(l,4)
3742 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3743 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3744 s1=scalar2(b1(1,iti2),auxvec(1))
3745 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3746 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3747 s2=scalar2(b1(1,iti1),auxvec(1))
3748 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3749 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3750 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3751 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3752 a_temp(1,1)=aggi1(l,1)
3753 a_temp(1,2)=aggi1(l,2)
3754 a_temp(2,1)=aggi1(l,3)
3755 a_temp(2,2)=aggi1(l,4)
3756 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3757 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3758 s1=scalar2(b1(1,iti2),auxvec(1))
3759 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3760 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3761 s2=scalar2(b1(1,iti1),auxvec(1))
3762 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3763 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3764 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3765 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3766 a_temp(1,1)=aggj(l,1)
3767 a_temp(1,2)=aggj(l,2)
3768 a_temp(2,1)=aggj(l,3)
3769 a_temp(2,2)=aggj(l,4)
3770 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3771 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3772 s1=scalar2(b1(1,iti2),auxvec(1))
3773 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3774 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3775 s2=scalar2(b1(1,iti1),auxvec(1))
3776 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3777 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3778 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3779 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3780 a_temp(1,1)=aggj1(l,1)
3781 a_temp(1,2)=aggj1(l,2)
3782 a_temp(2,1)=aggj1(l,3)
3783 a_temp(2,2)=aggj1(l,4)
3784 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3785 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3786 s1=scalar2(b1(1,iti2),auxvec(1))
3787 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3788 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3789 s2=scalar2(b1(1,iti1),auxvec(1))
3790 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3791 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3792 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3793 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3794 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3798 C-----------------------------------------------------------------------------
3799 subroutine vecpr(u,v,w)
3800 implicit real*8(a-h,o-z)
3801 dimension u(3),v(3),w(3)
3802 w(1)=u(2)*v(3)-u(3)*v(2)
3803 w(2)=-u(1)*v(3)+u(3)*v(1)
3804 w(3)=u(1)*v(2)-u(2)*v(1)
3807 C-----------------------------------------------------------------------------
3808 subroutine unormderiv(u,ugrad,unorm,ungrad)
3809 C This subroutine computes the derivatives of a normalized vector u, given
3810 C the derivatives computed without normalization conditions, ugrad. Returns
3813 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3814 double precision vec(3)
3815 double precision scalar
3817 c write (2,*) 'ugrad',ugrad
3820 vec(i)=scalar(ugrad(1,i),u(1))
3822 c write (2,*) 'vec',vec
3825 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3828 c write (2,*) 'ungrad',ungrad
3831 C-----------------------------------------------------------------------------
3832 subroutine escp_soft_sphere(evdw2,evdw2_14)
3834 C This subroutine calculates the excluded-volume interaction energy between
3835 C peptide-group centers and side chains and its gradient in virtual-bond and
3836 C side-chain vectors.
3838 implicit real*8 (a-h,o-z)
3839 include 'DIMENSIONS'
3840 include 'COMMON.GEO'
3841 include 'COMMON.VAR'
3842 include 'COMMON.LOCAL'
3843 include 'COMMON.CHAIN'
3844 include 'COMMON.DERIV'
3845 include 'COMMON.INTERACT'
3846 include 'COMMON.FFIELD'
3847 include 'COMMON.IOUNITS'
3848 include 'COMMON.CONTROL'
3853 cd print '(a)','Enter ESCP'
3854 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3855 do i=iatscp_s,iatscp_e
3856 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3858 xi=0.5D0*(c(1,i)+c(1,i+1))
3859 yi=0.5D0*(c(2,i)+c(2,i+1))
3860 zi=0.5D0*(c(3,i)+c(3,i+1))
3862 do iint=1,nscp_gr(i)
3864 do j=iscpstart(i,iint),iscpend(i,iint)
3865 if (itype(j).eq.ntyp1) cycle
3866 itypj=iabs(itype(j))
3867 C Uncomment following three lines for SC-p interactions
3871 C Uncomment following three lines for Ca-p interactions
3875 rij=xj*xj+yj*yj+zj*zj
3878 if (rij.lt.r0ijsq) then
3879 evdwij=0.25d0*(rij-r0ijsq)**2
3887 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3892 cgrad if (j.lt.i) then
3893 cd write (iout,*) 'j<i'
3894 C Uncomment following three lines for SC-p interactions
3896 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3899 cd write (iout,*) 'j>i'
3901 cgrad ggg(k)=-ggg(k)
3902 C Uncomment following line for SC-p interactions
3903 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3907 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3909 cgrad kstart=min0(i+1,j)
3910 cgrad kend=max0(i-1,j-1)
3911 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3912 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3913 cgrad do k=kstart,kend
3915 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3919 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3920 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3928 C-----------------------------------------------------------------------------
3929 subroutine escp(evdw2,evdw2_14)
3931 C This subroutine calculates the excluded-volume interaction energy between
3932 C peptide-group centers and side chains and its gradient in virtual-bond and
3933 C side-chain vectors.
3935 implicit real*8 (a-h,o-z)
3936 include 'DIMENSIONS'
3937 include 'COMMON.GEO'
3938 include 'COMMON.VAR'
3939 include 'COMMON.LOCAL'
3940 include 'COMMON.CHAIN'
3941 include 'COMMON.DERIV'
3942 include 'COMMON.INTERACT'
3943 include 'COMMON.FFIELD'
3944 include 'COMMON.IOUNITS'
3945 include 'COMMON.CONTROL'
3949 cd print '(a)','Enter ESCP'
3950 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3951 do i=iatscp_s,iatscp_e
3952 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3954 xi=0.5D0*(c(1,i)+c(1,i+1))
3955 yi=0.5D0*(c(2,i)+c(2,i+1))
3956 zi=0.5D0*(c(3,i)+c(3,i+1))
3958 do iint=1,nscp_gr(i)
3960 do j=iscpstart(i,iint),iscpend(i,iint)
3961 itypj=iabs(itype(j))
3962 if (itypj.eq.ntyp1) cycle
3963 C Uncomment following three lines for SC-p interactions
3967 C Uncomment following three lines for Ca-p interactions
3971 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3973 e1=fac*fac*aad(itypj,iteli)
3974 e2=fac*bad(itypj,iteli)
3975 if (iabs(j-i) .le. 2) then
3978 evdw2_14=evdw2_14+e1+e2
3982 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3983 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3986 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3988 fac=-(evdwij+e1)*rrij
3992 cgrad if (j.lt.i) then
3993 cd write (iout,*) 'j<i'
3994 C Uncomment following three lines for SC-p interactions
3996 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3999 cd write (iout,*) 'j>i'
4001 cgrad ggg(k)=-ggg(k)
4002 C Uncomment following line for SC-p interactions
4003 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4004 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4008 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4010 cgrad kstart=min0(i+1,j)
4011 cgrad kend=max0(i-1,j-1)
4012 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4013 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4014 cgrad do k=kstart,kend
4016 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4020 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4021 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4029 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4030 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4031 gradx_scp(j,i)=expon*gradx_scp(j,i)
4034 C******************************************************************************
4038 C To save time the factor EXPON has been extracted from ALL components
4039 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4042 C******************************************************************************
4045 C--------------------------------------------------------------------------
4046 subroutine edis(ehpb)
4048 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4050 implicit real*8 (a-h,o-z)
4051 include 'DIMENSIONS'
4052 include 'COMMON.SBRIDGE'
4053 include 'COMMON.CHAIN'
4054 include 'COMMON.DERIV'
4055 include 'COMMON.VAR'
4056 include 'COMMON.INTERACT'
4057 include 'COMMON.IOUNITS'
4060 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4061 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4062 if (link_end.eq.0) return
4063 do i=link_start,link_end
4064 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4065 C CA-CA distance used in regularization of structure.
4068 C iii and jjj point to the residues for which the distance is assigned.
4069 if (ii.gt.nres) then
4076 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4077 c & dhpb(i),dhpb1(i),forcon(i)
4078 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4079 C distance and angle dependent SS bond potential.
4080 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4081 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4082 if (.not.dyn_ss .and. i.le.nss) then
4083 C 15/02/13 CC dynamic SSbond - additional check
4084 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4085 & iabs(itype(jjj)).eq.1) then
4086 call ssbond_ene(iii,jjj,eij)
4089 cd write (iout,*) "eij",eij
4092 C Calculate the distance between the two points and its difference from the
4096 C Get the force constant corresponding to this distance.
4098 C Calculate the contribution to energy.
4099 ehpb=ehpb+waga*rdis*rdis
4101 C Evaluate gradient.
4104 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4105 cd & ' waga=',waga,' fac=',fac
4107 ggg(j)=fac*(c(j,jj)-c(j,ii))
4109 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4110 C If this is a SC-SC distance, we need to calculate the contributions to the
4111 C Cartesian gradient in the SC vectors (ghpbx).
4114 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4115 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4118 cgrad do j=iii,jjj-1
4120 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4124 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4125 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4132 C--------------------------------------------------------------------------
4133 subroutine ssbond_ene(i,j,eij)
4135 C Calculate the distance and angle dependent SS-bond potential energy
4136 C using a free-energy function derived based on RHF/6-31G** ab initio
4137 C calculations of diethyl disulfide.
4139 C A. Liwo and U. Kozlowska, 11/24/03
4141 implicit real*8 (a-h,o-z)
4142 include 'DIMENSIONS'
4143 include 'COMMON.SBRIDGE'
4144 include 'COMMON.CHAIN'
4145 include 'COMMON.DERIV'
4146 include 'COMMON.LOCAL'
4147 include 'COMMON.INTERACT'
4148 include 'COMMON.VAR'
4149 include 'COMMON.IOUNITS'
4150 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4151 itypi=iabs(itype(i))
4155 dxi=dc_norm(1,nres+i)
4156 dyi=dc_norm(2,nres+i)
4157 dzi=dc_norm(3,nres+i)
4158 c dsci_inv=dsc_inv(itypi)
4159 dsci_inv=vbld_inv(nres+i)
4160 itypj=iabs(itype(j))
4161 c dscj_inv=dsc_inv(itypj)
4162 dscj_inv=vbld_inv(nres+j)
4166 dxj=dc_norm(1,nres+j)
4167 dyj=dc_norm(2,nres+j)
4168 dzj=dc_norm(3,nres+j)
4169 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4174 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4175 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4176 om12=dxi*dxj+dyi*dyj+dzi*dzj
4178 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4179 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4185 deltat12=om2-om1+2.0d0
4187 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4188 & +akct*deltad*deltat12
4189 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4190 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4191 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4192 c & " deltat12",deltat12," eij",eij
4193 ed=2*akcm*deltad+akct*deltat12
4195 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4196 eom1=-2*akth*deltat1-pom1-om2*pom2
4197 eom2= 2*akth*deltat2+pom1-om1*pom2
4200 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4201 ghpbx(k,i)=ghpbx(k,i)-ggk
4202 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4203 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4204 ghpbx(k,j)=ghpbx(k,j)+ggk
4205 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4206 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4207 ghpbc(k,i)=ghpbc(k,i)-ggk
4208 ghpbc(k,j)=ghpbc(k,j)+ggk
4211 C Calculate the components of the gradient in DC and X
4215 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4220 C--------------------------------------------------------------------------
4221 subroutine ebond(estr)
4223 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4225 implicit real*8 (a-h,o-z)
4226 include 'DIMENSIONS'
4227 include 'COMMON.LOCAL'
4228 include 'COMMON.GEO'
4229 include 'COMMON.INTERACT'
4230 include 'COMMON.DERIV'
4231 include 'COMMON.VAR'
4232 include 'COMMON.CHAIN'
4233 include 'COMMON.IOUNITS'
4234 include 'COMMON.NAMES'
4235 include 'COMMON.FFIELD'
4236 include 'COMMON.CONTROL'
4237 include 'COMMON.SETUP'
4238 double precision u(3),ud(3)
4241 do i=ibondp_start,ibondp_end
4242 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4243 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4245 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4246 & *dc(j,i-1)/vbld(i)
4248 if (energy_dec) write(iout,*)
4249 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4251 diff = vbld(i)-vbldp0
4252 if (energy_dec) write (iout,*)
4253 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4256 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4258 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4261 estr=0.5d0*AKP*estr+estr1
4263 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4265 do i=ibond_start,ibond_end
4267 if (iti.ne.10 .and. iti.ne.ntyp1) then
4270 diff=vbld(i+nres)-vbldsc0(1,iti)
4271 if (energy_dec) write (iout,*)
4272 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4273 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4274 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4276 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4280 diff=vbld(i+nres)-vbldsc0(j,iti)
4281 ud(j)=aksc(j,iti)*diff
4282 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4296 uprod2=uprod2*u(k)*u(k)
4300 usumsqder=usumsqder+ud(j)*uprod2
4302 estr=estr+uprod/usum
4304 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4312 C--------------------------------------------------------------------------
4313 subroutine ebend(etheta)
4315 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4316 C angles gamma and its derivatives in consecutive thetas and gammas.
4318 implicit real*8 (a-h,o-z)
4319 include 'DIMENSIONS'
4320 include 'COMMON.LOCAL'
4321 include 'COMMON.GEO'
4322 include 'COMMON.INTERACT'
4323 include 'COMMON.DERIV'
4324 include 'COMMON.VAR'
4325 include 'COMMON.CHAIN'
4326 include 'COMMON.IOUNITS'
4327 include 'COMMON.NAMES'
4328 include 'COMMON.FFIELD'
4329 include 'COMMON.CONTROL'
4330 common /calcthet/ term1,term2,termm,diffak,ratak,
4331 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4332 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4333 double precision y(2),z(2)
4335 c time11=dexp(-2*time)
4338 c write (*,'(a,i2)') 'EBEND ICG=',icg
4339 do i=ithet_start,ithet_end
4340 if (itype(i-1).eq.ntyp1) cycle
4341 C Zero the energy function and its derivative at 0 or pi.
4342 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4344 ichir1=isign(1,itype(i-2))
4345 ichir2=isign(1,itype(i))
4346 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4347 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4348 if (itype(i-1).eq.10) then
4349 itype1=isign(10,itype(i-2))
4350 ichir11=isign(1,itype(i-2))
4351 ichir12=isign(1,itype(i-2))
4352 itype2=isign(10,itype(i))
4353 ichir21=isign(1,itype(i))
4354 ichir22=isign(1,itype(i))
4357 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4360 if (phii.ne.phii) phii=150.0
4370 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4373 if (phii1.ne.phii1) phii1=150.0
4385 C Calculate the "mean" value of theta from the part of the distribution
4386 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4387 C In following comments this theta will be referred to as t_c.
4388 thet_pred_mean=0.0d0
4390 athetk=athet(k,it,ichir1,ichir2)
4391 bthetk=bthet(k,it,ichir1,ichir2)
4393 athetk=athet(k,itype1,ichir11,ichir12)
4394 bthetk=bthet(k,itype2,ichir21,ichir22)
4396 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4398 dthett=thet_pred_mean*ssd
4399 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4400 C Derivatives of the "mean" values in gamma1 and gamma2.
4401 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4402 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4403 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4404 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4406 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4407 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4408 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4409 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4411 if (theta(i).gt.pi-delta) then
4412 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4414 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4415 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4416 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4418 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4420 else if (theta(i).lt.delta) then
4421 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4422 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4423 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4425 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4426 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4429 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4432 etheta=etheta+ethetai
4433 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4435 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4436 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4437 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4439 C Ufff.... We've done all this!!!
4442 C---------------------------------------------------------------------------
4443 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4445 implicit real*8 (a-h,o-z)
4446 include 'DIMENSIONS'
4447 include 'COMMON.LOCAL'
4448 include 'COMMON.IOUNITS'
4449 common /calcthet/ term1,term2,termm,diffak,ratak,
4450 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4451 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4452 C Calculate the contributions to both Gaussian lobes.
4453 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4454 C The "polynomial part" of the "standard deviation" of this part of
4458 sig=sig*thet_pred_mean+polthet(j,it)
4460 C Derivative of the "interior part" of the "standard deviation of the"
4461 C gamma-dependent Gaussian lobe in t_c.
4462 sigtc=3*polthet(3,it)
4464 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4467 C Set the parameters of both Gaussian lobes of the distribution.
4468 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4469 fac=sig*sig+sigc0(it)
4472 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4473 sigsqtc=-4.0D0*sigcsq*sigtc
4474 c print *,i,sig,sigtc,sigsqtc
4475 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4476 sigtc=-sigtc/(fac*fac)
4477 C Following variable is sigma(t_c)**(-2)
4478 sigcsq=sigcsq*sigcsq
4480 sig0inv=1.0D0/sig0i**2
4481 delthec=thetai-thet_pred_mean
4482 delthe0=thetai-theta0i
4483 term1=-0.5D0*sigcsq*delthec*delthec
4484 term2=-0.5D0*sig0inv*delthe0*delthe0
4485 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4486 C NaNs in taking the logarithm. We extract the largest exponent which is added
4487 C to the energy (this being the log of the distribution) at the end of energy
4488 C term evaluation for this virtual-bond angle.
4489 if (term1.gt.term2) then
4491 term2=dexp(term2-termm)
4495 term1=dexp(term1-termm)
4498 C The ratio between the gamma-independent and gamma-dependent lobes of
4499 C the distribution is a Gaussian function of thet_pred_mean too.
4500 diffak=gthet(2,it)-thet_pred_mean
4501 ratak=diffak/gthet(3,it)**2
4502 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4503 C Let's differentiate it in thet_pred_mean NOW.
4505 C Now put together the distribution terms to make complete distribution.
4506 termexp=term1+ak*term2
4507 termpre=sigc+ak*sig0i
4508 C Contribution of the bending energy from this theta is just the -log of
4509 C the sum of the contributions from the two lobes and the pre-exponential
4510 C factor. Simple enough, isn't it?
4511 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4512 C NOW the derivatives!!!
4513 C 6/6/97 Take into account the deformation.
4514 E_theta=(delthec*sigcsq*term1
4515 & +ak*delthe0*sig0inv*term2)/termexp
4516 E_tc=((sigtc+aktc*sig0i)/termpre
4517 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4518 & aktc*term2)/termexp)
4521 c-----------------------------------------------------------------------------
4522 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4523 implicit real*8 (a-h,o-z)
4524 include 'DIMENSIONS'
4525 include 'COMMON.LOCAL'
4526 include 'COMMON.IOUNITS'
4527 common /calcthet/ term1,term2,termm,diffak,ratak,
4528 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4529 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4530 delthec=thetai-thet_pred_mean
4531 delthe0=thetai-theta0i
4532 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4533 t3 = thetai-thet_pred_mean
4537 t14 = t12+t6*sigsqtc
4539 t21 = thetai-theta0i
4545 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4546 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4547 & *(-t12*t9-ak*sig0inv*t27)
4551 C--------------------------------------------------------------------------
4552 subroutine ebend(etheta)
4554 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4555 C angles gamma and its derivatives in consecutive thetas and gammas.
4556 C ab initio-derived potentials from
4557 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4559 implicit real*8 (a-h,o-z)
4560 include 'DIMENSIONS'
4561 include 'COMMON.LOCAL'
4562 include 'COMMON.GEO'
4563 include 'COMMON.INTERACT'
4564 include 'COMMON.DERIV'
4565 include 'COMMON.VAR'
4566 include 'COMMON.CHAIN'
4567 include 'COMMON.IOUNITS'
4568 include 'COMMON.NAMES'
4569 include 'COMMON.FFIELD'
4570 include 'COMMON.CONTROL'
4571 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4572 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4573 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4574 & sinph1ph2(maxdouble,maxdouble)
4575 logical lprn /.false./, lprn1 /.false./
4577 do i=ithet_start,ithet_end
4578 if (itype(i-1).eq.ntyp1) cycle
4579 if (iabs(itype(i+1)).eq.20) iblock=2
4580 if (iabs(itype(i+1)).ne.20) iblock=1
4584 theti2=0.5d0*theta(i)
4585 ityp2=ithetyp((itype(i-1)))
4587 coskt(k)=dcos(k*theti2)
4588 sinkt(k)=dsin(k*theti2)
4590 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4593 if (phii.ne.phii) phii=150.0
4597 ityp1=ithetyp((itype(i-2)))
4598 C propagation of chirality for glycine type
4600 cosph1(k)=dcos(k*phii)
4601 sinph1(k)=dsin(k*phii)
4611 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4614 if (phii1.ne.phii1) phii1=150.0
4619 ityp3=ithetyp((itype(i)))
4621 cosph2(k)=dcos(k*phii1)
4622 sinph2(k)=dsin(k*phii1)
4632 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4635 ccl=cosph1(l)*cosph2(k-l)
4636 ssl=sinph1(l)*sinph2(k-l)
4637 scl=sinph1(l)*cosph2(k-l)
4638 csl=cosph1(l)*sinph2(k-l)
4639 cosph1ph2(l,k)=ccl-ssl
4640 cosph1ph2(k,l)=ccl+ssl
4641 sinph1ph2(l,k)=scl+csl
4642 sinph1ph2(k,l)=scl-csl
4646 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4647 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4648 write (iout,*) "coskt and sinkt"
4650 write (iout,*) k,coskt(k),sinkt(k)
4654 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4655 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4658 & write (iout,*) "k",k,"
4659 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4660 & " ethetai",ethetai
4663 write (iout,*) "cosph and sinph"
4665 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4667 write (iout,*) "cosph1ph2 and sinph2ph2"
4670 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4671 & sinph1ph2(l,k),sinph1ph2(k,l)
4674 write(iout,*) "ethetai",ethetai
4678 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4679 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4680 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4681 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4682 ethetai=ethetai+sinkt(m)*aux
4683 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4684 dephii=dephii+k*sinkt(m)*(
4685 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4686 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4687 dephii1=dephii1+k*sinkt(m)*(
4688 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4689 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4691 & write (iout,*) "m",m," k",k," bbthet",
4692 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4693 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4694 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4695 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4699 & write(iout,*) "ethetai",ethetai
4703 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4704 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4705 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4706 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4707 ethetai=ethetai+sinkt(m)*aux
4708 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4709 dephii=dephii+l*sinkt(m)*(
4710 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4711 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4712 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4713 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4714 dephii1=dephii1+(k-l)*sinkt(m)*(
4715 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4716 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4717 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4718 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4720 write (iout,*) "m",m," k",k," l",l," ffthet",
4721 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4722 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4723 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4724 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4725 & " ethetai",ethetai
4726 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4727 & cosph1ph2(k,l)*sinkt(m),
4728 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4736 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4737 & i,theta(i)*rad2deg,phii*rad2deg,
4738 & phii1*rad2deg,ethetai
4740 etheta=etheta+ethetai
4741 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4742 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4743 gloc(nphi+i-2,icg)=wang*dethetai
4749 c-----------------------------------------------------------------------------
4750 subroutine esc(escloc)
4751 C Calculate the local energy of a side chain and its derivatives in the
4752 C corresponding virtual-bond valence angles THETA and the spherical angles
4754 implicit real*8 (a-h,o-z)
4755 include 'DIMENSIONS'
4756 include 'COMMON.GEO'
4757 include 'COMMON.LOCAL'
4758 include 'COMMON.VAR'
4759 include 'COMMON.INTERACT'
4760 include 'COMMON.DERIV'
4761 include 'COMMON.CHAIN'
4762 include 'COMMON.IOUNITS'
4763 include 'COMMON.NAMES'
4764 include 'COMMON.FFIELD'
4765 include 'COMMON.CONTROL'
4766 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4767 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4768 common /sccalc/ time11,time12,time112,theti,it,nlobit
4771 c write (iout,'(a)') 'ESC'
4772 do i=loc_start,loc_end
4774 if (it.eq.ntyp1) cycle
4775 if (it.eq.10) goto 1
4776 nlobit=nlob(iabs(it))
4777 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4778 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4779 theti=theta(i+1)-pipol
4784 if (x(2).gt.pi-delta) then
4788 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4790 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4791 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4793 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4794 & ddersc0(1),dersc(1))
4795 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4796 & ddersc0(3),dersc(3))
4798 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4800 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4801 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4802 & dersc0(2),esclocbi,dersc02)
4803 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4805 call splinthet(x(2),0.5d0*delta,ss,ssd)
4810 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4812 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4813 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4815 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4817 c write (iout,*) escloci
4818 else if (x(2).lt.delta) then
4822 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4824 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4825 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4827 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4828 & ddersc0(1),dersc(1))
4829 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4830 & ddersc0(3),dersc(3))
4832 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4834 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4835 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4836 & dersc0(2),esclocbi,dersc02)
4837 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4842 call splinthet(x(2),0.5d0*delta,ss,ssd)
4844 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4846 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4847 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4849 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4850 c write (iout,*) escloci
4852 call enesc(x,escloci,dersc,ddummy,.false.)
4855 escloc=escloc+escloci
4856 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4857 & 'escloc',i,escloci
4858 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4860 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4862 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4863 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4868 C---------------------------------------------------------------------------
4869 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4870 implicit real*8 (a-h,o-z)
4871 include 'DIMENSIONS'
4872 include 'COMMON.GEO'
4873 include 'COMMON.LOCAL'
4874 include 'COMMON.IOUNITS'
4875 common /sccalc/ time11,time12,time112,theti,it,nlobit
4876 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4877 double precision contr(maxlob,-1:1)
4879 c write (iout,*) 'it=',it,' nlobit=',nlobit
4883 if (mixed) ddersc(j)=0.0d0
4887 C Because of periodicity of the dependence of the SC energy in omega we have
4888 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4889 C To avoid underflows, first compute & store the exponents.
4897 z(k)=x(k)-censc(k,j,it)
4902 Axk=Axk+gaussc(l,k,j,it)*z(l)
4908 expfac=expfac+Ax(k,j,iii)*z(k)
4916 C As in the case of ebend, we want to avoid underflows in exponentiation and
4917 C subsequent NaNs and INFs in energy calculation.
4918 C Find the largest exponent
4922 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4926 cd print *,'it=',it,' emin=',emin
4928 C Compute the contribution to SC energy and derivatives
4933 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
4934 if(adexp.ne.adexp) adexp=1.0
4937 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4939 cd print *,'j=',j,' expfac=',expfac
4940 escloc_i=escloc_i+expfac
4942 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4946 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4947 & +gaussc(k,2,j,it))*expfac
4954 dersc(1)=dersc(1)/cos(theti)**2
4955 ddersc(1)=ddersc(1)/cos(theti)**2
4958 escloci=-(dlog(escloc_i)-emin)
4960 dersc(j)=dersc(j)/escloc_i
4964 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4969 C------------------------------------------------------------------------------
4970 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4971 implicit real*8 (a-h,o-z)
4972 include 'DIMENSIONS'
4973 include 'COMMON.GEO'
4974 include 'COMMON.LOCAL'
4975 include 'COMMON.IOUNITS'
4976 common /sccalc/ time11,time12,time112,theti,it,nlobit
4977 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4978 double precision contr(maxlob)
4989 z(k)=x(k)-censc(k,j,it)
4995 Axk=Axk+gaussc(l,k,j,it)*z(l)
5001 expfac=expfac+Ax(k,j)*z(k)
5006 C As in the case of ebend, we want to avoid underflows in exponentiation and
5007 C subsequent NaNs and INFs in energy calculation.
5008 C Find the largest exponent
5011 if (emin.gt.contr(j)) emin=contr(j)
5015 C Compute the contribution to SC energy and derivatives
5019 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5020 escloc_i=escloc_i+expfac
5022 dersc(k)=dersc(k)+Ax(k,j)*expfac
5024 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5025 & +gaussc(1,2,j,it))*expfac
5029 dersc(1)=dersc(1)/cos(theti)**2
5030 dersc12=dersc12/cos(theti)**2
5031 escloci=-(dlog(escloc_i)-emin)
5033 dersc(j)=dersc(j)/escloc_i
5035 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5039 c----------------------------------------------------------------------------------
5040 subroutine esc(escloc)
5041 C Calculate the local energy of a side chain and its derivatives in the
5042 C corresponding virtual-bond valence angles THETA and the spherical angles
5043 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5044 C added by Urszula Kozlowska. 07/11/2007
5046 implicit real*8 (a-h,o-z)
5047 include 'DIMENSIONS'
5048 include 'COMMON.GEO'
5049 include 'COMMON.LOCAL'
5050 include 'COMMON.VAR'
5051 include 'COMMON.SCROT'
5052 include 'COMMON.INTERACT'
5053 include 'COMMON.DERIV'
5054 include 'COMMON.CHAIN'
5055 include 'COMMON.IOUNITS'
5056 include 'COMMON.NAMES'
5057 include 'COMMON.FFIELD'
5058 include 'COMMON.CONTROL'
5059 include 'COMMON.VECTORS'
5060 double precision x_prime(3),y_prime(3),z_prime(3)
5061 & , sumene,dsc_i,dp2_i,x(65),
5062 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5063 & de_dxx,de_dyy,de_dzz,de_dt
5064 double precision s1_t,s1_6_t,s2_t,s2_6_t
5066 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5067 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5068 & dt_dCi(3),dt_dCi1(3)
5069 common /sccalc/ time11,time12,time112,theti,it,nlobit
5072 do i=loc_start,loc_end
5073 if (itype(i).eq.ntyp1) cycle
5074 costtab(i+1) =dcos(theta(i+1))
5075 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5076 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5077 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5078 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5079 cosfac=dsqrt(cosfac2)
5080 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5081 sinfac=dsqrt(sinfac2)
5083 if (it.eq.10) goto 1
5085 C Compute the axes of tghe local cartesian coordinates system; store in
5086 c x_prime, y_prime and z_prime
5093 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5094 C & dc_norm(3,i+nres)
5096 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5097 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5100 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5103 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5104 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5105 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5106 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5107 c & " xy",scalar(x_prime(1),y_prime(1)),
5108 c & " xz",scalar(x_prime(1),z_prime(1)),
5109 c & " yy",scalar(y_prime(1),y_prime(1)),
5110 c & " yz",scalar(y_prime(1),z_prime(1)),
5111 c & " zz",scalar(z_prime(1),z_prime(1))
5113 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5114 C to local coordinate system. Store in xx, yy, zz.
5120 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5121 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5122 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5129 C Compute the energy of the ith side cbain
5131 c write (2,*) "xx",xx," yy",yy," zz",zz
5134 x(j) = sc_parmin(j,it)
5137 Cc diagnostics - remove later
5139 yy1 = dsin(alph(2))*dcos(omeg(2))
5140 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5141 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5142 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5144 C," --- ", xx_w,yy_w,zz_w
5147 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5148 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5150 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5151 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5153 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5154 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5155 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5156 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5157 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5159 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5160 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5161 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5162 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5163 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5165 dsc_i = 0.743d0+x(61)
5167 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5168 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5169 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5170 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5171 s1=(1+x(63))/(0.1d0 + dscp1)
5172 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5173 s2=(1+x(65))/(0.1d0 + dscp2)
5174 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5175 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5176 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5177 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5179 c & dscp1,dscp2,sumene
5180 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5181 escloc = escloc + sumene
5182 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5187 C This section to check the numerical derivatives of the energy of ith side
5188 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5189 C #define DEBUG in the code to turn it on.
5191 write (2,*) "sumene =",sumene
5195 write (2,*) xx,yy,zz
5196 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5197 de_dxx_num=(sumenep-sumene)/aincr
5199 write (2,*) "xx+ sumene from enesc=",sumenep
5202 write (2,*) xx,yy,zz
5203 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5204 de_dyy_num=(sumenep-sumene)/aincr
5206 write (2,*) "yy+ sumene from enesc=",sumenep
5209 write (2,*) xx,yy,zz
5210 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5211 de_dzz_num=(sumenep-sumene)/aincr
5213 write (2,*) "zz+ sumene from enesc=",sumenep
5214 costsave=cost2tab(i+1)
5215 sintsave=sint2tab(i+1)
5216 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5217 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5218 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5219 de_dt_num=(sumenep-sumene)/aincr
5220 write (2,*) " t+ sumene from enesc=",sumenep
5221 cost2tab(i+1)=costsave
5222 sint2tab(i+1)=sintsave
5223 C End of diagnostics section.
5226 C Compute the gradient of esc
5228 c zz=zz*dsign(1.0,dfloat(itype(i)))
5229 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5230 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5231 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5232 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5233 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5234 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5235 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5236 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5237 pom1=(sumene3*sint2tab(i+1)+sumene1)
5238 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5239 pom2=(sumene4*cost2tab(i+1)+sumene2)
5240 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5241 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5242 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5243 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5245 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5246 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5247 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5249 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5250 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5251 & +(pom1+pom2)*pom_dx
5253 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5256 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5257 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5258 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5260 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5261 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5262 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5263 & +x(59)*zz**2 +x(60)*xx*zz
5264 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5265 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5266 & +(pom1-pom2)*pom_dy
5268 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5271 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5272 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5273 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5274 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5275 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5276 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5277 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5278 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5280 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5283 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5284 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5285 & +pom1*pom_dt1+pom2*pom_dt2
5287 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5292 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5293 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5294 cosfac2xx=cosfac2*xx
5295 sinfac2yy=sinfac2*yy
5297 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5299 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5301 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5302 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5303 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5304 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5305 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5306 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5307 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5308 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5309 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5310 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5314 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5315 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5316 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5317 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5320 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5321 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5322 dZZ_XYZ(k)=vbld_inv(i+nres)*
5323 & (z_prime(k)-zz*dC_norm(k,i+nres))
5325 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5326 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5330 dXX_Ctab(k,i)=dXX_Ci(k)
5331 dXX_C1tab(k,i)=dXX_Ci1(k)
5332 dYY_Ctab(k,i)=dYY_Ci(k)
5333 dYY_C1tab(k,i)=dYY_Ci1(k)
5334 dZZ_Ctab(k,i)=dZZ_Ci(k)
5335 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5336 dXX_XYZtab(k,i)=dXX_XYZ(k)
5337 dYY_XYZtab(k,i)=dYY_XYZ(k)
5338 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5342 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5343 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5344 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5345 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5346 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5348 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5349 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5350 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5351 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5352 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5353 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5354 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5355 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5357 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5358 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5360 C to check gradient call subroutine check_grad
5366 c------------------------------------------------------------------------------
5367 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5369 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5370 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5371 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5372 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5374 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5375 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5377 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5378 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5379 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5380 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5381 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5383 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5384 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5385 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5386 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5387 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5389 dsc_i = 0.743d0+x(61)
5391 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5392 & *(xx*cost2+yy*sint2))
5393 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5394 & *(xx*cost2-yy*sint2))
5395 s1=(1+x(63))/(0.1d0 + dscp1)
5396 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5397 s2=(1+x(65))/(0.1d0 + dscp2)
5398 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5399 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5400 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5405 c------------------------------------------------------------------------------
5406 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5408 C This procedure calculates two-body contact function g(rij) and its derivative:
5411 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5414 C where x=(rij-r0ij)/delta
5416 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5419 double precision rij,r0ij,eps0ij,fcont,fprimcont
5420 double precision x,x2,x4,delta
5424 if (x.lt.-1.0D0) then
5427 else if (x.le.1.0D0) then
5430 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5431 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5438 c------------------------------------------------------------------------------
5439 subroutine splinthet(theti,delta,ss,ssder)
5440 implicit real*8 (a-h,o-z)
5441 include 'DIMENSIONS'
5442 include 'COMMON.VAR'
5443 include 'COMMON.GEO'
5446 if (theti.gt.pipol) then
5447 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5449 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5454 c------------------------------------------------------------------------------
5455 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5457 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5458 double precision ksi,ksi2,ksi3,a1,a2,a3
5459 a1=fprim0*delta/(f1-f0)
5465 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5466 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5469 c------------------------------------------------------------------------------
5470 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5472 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5473 double precision ksi,ksi2,ksi3,a1,a2,a3
5478 a2=3*(f1x-f0x)-2*fprim0x*delta
5479 a3=fprim0x*delta-2*(f1x-f0x)
5480 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5483 C-----------------------------------------------------------------------------
5485 C-----------------------------------------------------------------------------
5486 subroutine etor(etors,edihcnstr)
5487 implicit real*8 (a-h,o-z)
5488 include 'DIMENSIONS'
5489 include 'COMMON.VAR'
5490 include 'COMMON.GEO'
5491 include 'COMMON.LOCAL'
5492 include 'COMMON.TORSION'
5493 include 'COMMON.INTERACT'
5494 include 'COMMON.DERIV'
5495 include 'COMMON.CHAIN'
5496 include 'COMMON.NAMES'
5497 include 'COMMON.IOUNITS'
5498 include 'COMMON.FFIELD'
5499 include 'COMMON.TORCNSTR'
5500 include 'COMMON.CONTROL'
5502 C Set lprn=.true. for debugging
5506 do i=iphi_start,iphi_end
5508 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5509 & .or. itype(i).eq.ntyp1) cycle
5510 itori=itortyp(itype(i-2))
5511 itori1=itortyp(itype(i-1))
5514 C Proline-Proline pair is a special case...
5515 if (itori.eq.3 .and. itori1.eq.3) then
5516 if (phii.gt.-dwapi3) then
5518 fac=1.0D0/(1.0D0-cosphi)
5519 etorsi=v1(1,3,3)*fac
5520 etorsi=etorsi+etorsi
5521 etors=etors+etorsi-v1(1,3,3)
5522 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5523 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5526 v1ij=v1(j+1,itori,itori1)
5527 v2ij=v2(j+1,itori,itori1)
5530 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5531 if (energy_dec) etors_ii=etors_ii+
5532 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5533 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5537 v1ij=v1(j,itori,itori1)
5538 v2ij=v2(j,itori,itori1)
5541 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5542 if (energy_dec) etors_ii=etors_ii+
5543 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5544 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5547 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5550 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5551 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5552 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5553 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5554 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5556 ! 6/20/98 - dihedral angle constraints
5559 itori=idih_constr(i)
5562 if (difi.gt.drange(i)) then
5564 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5565 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5566 else if (difi.lt.-drange(i)) then
5568 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5569 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5571 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5572 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5574 ! write (iout,*) 'edihcnstr',edihcnstr
5577 c------------------------------------------------------------------------------
5578 subroutine etor_d(etors_d)
5582 c----------------------------------------------------------------------------
5584 subroutine etor(etors,edihcnstr)
5585 implicit real*8 (a-h,o-z)
5586 include 'DIMENSIONS'
5587 include 'COMMON.VAR'
5588 include 'COMMON.GEO'
5589 include 'COMMON.LOCAL'
5590 include 'COMMON.TORSION'
5591 include 'COMMON.INTERACT'
5592 include 'COMMON.DERIV'
5593 include 'COMMON.CHAIN'
5594 include 'COMMON.NAMES'
5595 include 'COMMON.IOUNITS'
5596 include 'COMMON.FFIELD'
5597 include 'COMMON.TORCNSTR'
5598 include 'COMMON.CONTROL'
5600 C Set lprn=.true. for debugging
5604 do i=iphi_start,iphi_end
5605 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5606 & .or. itype(i).eq.ntyp1) cycle
5608 if (iabs(itype(i)).eq.20) then
5613 itori=itortyp(itype(i-2))
5614 itori1=itortyp(itype(i-1))
5617 C Regular cosine and sine terms
5618 do j=1,nterm(itori,itori1,iblock)
5619 v1ij=v1(j,itori,itori1,iblock)
5620 v2ij=v2(j,itori,itori1,iblock)
5623 etors=etors+v1ij*cosphi+v2ij*sinphi
5624 if (energy_dec) etors_ii=etors_ii+
5625 & v1ij*cosphi+v2ij*sinphi
5626 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5630 C E = SUM ----------------------------------- - v1
5631 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5633 cosphi=dcos(0.5d0*phii)
5634 sinphi=dsin(0.5d0*phii)
5635 do j=1,nlor(itori,itori1,iblock)
5636 vl1ij=vlor1(j,itori,itori1)
5637 vl2ij=vlor2(j,itori,itori1)
5638 vl3ij=vlor3(j,itori,itori1)
5639 pom=vl2ij*cosphi+vl3ij*sinphi
5640 pom1=1.0d0/(pom*pom+1.0d0)
5641 etors=etors+vl1ij*pom1
5642 if (energy_dec) etors_ii=etors_ii+
5645 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5647 C Subtract the constant term
5648 etors=etors-v0(itori,itori1,iblock)
5649 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5650 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5652 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5653 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5654 & (v1(j,itori,itori1,iblock),j=1,6),
5655 & (v2(j,itori,itori1,iblock),j=1,6)
5656 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5657 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5659 ! 6/20/98 - dihedral angle constraints
5661 c do i=1,ndih_constr
5662 do i=idihconstr_start,idihconstr_end
5663 itori=idih_constr(i)
5665 difi=pinorm(phii-phi0(i))
5666 if (difi.gt.drange(i)) then
5668 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5669 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5670 else if (difi.lt.-drange(i)) then
5672 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5673 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5677 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5678 cd & rad2deg*phi0(i), rad2deg*drange(i),
5679 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5681 cd write (iout,*) 'edihcnstr',edihcnstr
5684 c----------------------------------------------------------------------------
5685 subroutine etor_d(etors_d)
5686 C 6/23/01 Compute double torsional energy
5687 implicit real*8 (a-h,o-z)
5688 include 'DIMENSIONS'
5689 include 'COMMON.VAR'
5690 include 'COMMON.GEO'
5691 include 'COMMON.LOCAL'
5692 include 'COMMON.TORSION'
5693 include 'COMMON.INTERACT'
5694 include 'COMMON.DERIV'
5695 include 'COMMON.CHAIN'
5696 include 'COMMON.NAMES'
5697 include 'COMMON.IOUNITS'
5698 include 'COMMON.FFIELD'
5699 include 'COMMON.TORCNSTR'
5701 C Set lprn=.true. for debugging
5705 c write(iout,*) "a tu??"
5706 do i=iphid_start,iphid_end
5707 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5708 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5709 itori=itortyp(itype(i-2))
5710 itori1=itortyp(itype(i-1))
5711 itori2=itortyp(itype(i))
5717 if (iabs(itype(i+1)).eq.20) iblock=2
5719 C Regular cosine and sine terms
5720 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5721 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5722 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5723 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5724 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5725 cosphi1=dcos(j*phii)
5726 sinphi1=dsin(j*phii)
5727 cosphi2=dcos(j*phii1)
5728 sinphi2=dsin(j*phii1)
5729 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5730 & v2cij*cosphi2+v2sij*sinphi2
5731 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5732 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5734 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5736 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5737 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5738 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5739 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5740 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5741 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5742 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5743 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5744 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5745 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5746 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5747 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5748 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5749 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5752 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5753 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5758 c------------------------------------------------------------------------------
5759 subroutine eback_sc_corr(esccor)
5760 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5761 c conformational states; temporarily implemented as differences
5762 c between UNRES torsional potentials (dependent on three types of
5763 c residues) and the torsional potentials dependent on all 20 types
5764 c of residues computed from AM1 energy surfaces of terminally-blocked
5765 c amino-acid residues.
5766 implicit real*8 (a-h,o-z)
5767 include 'DIMENSIONS'
5768 include 'COMMON.VAR'
5769 include 'COMMON.GEO'
5770 include 'COMMON.LOCAL'
5771 include 'COMMON.TORSION'
5772 include 'COMMON.SCCOR'
5773 include 'COMMON.INTERACT'
5774 include 'COMMON.DERIV'
5775 include 'COMMON.CHAIN'
5776 include 'COMMON.NAMES'
5777 include 'COMMON.IOUNITS'
5778 include 'COMMON.FFIELD'
5779 include 'COMMON.CONTROL'
5781 C Set lprn=.true. for debugging
5784 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5786 do i=itau_start,itau_end
5787 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5789 isccori=isccortyp(itype(i-2))
5790 isccori1=isccortyp(itype(i-1))
5791 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5793 do intertyp=1,3 !intertyp
5794 cc Added 09 May 2012 (Adasko)
5795 cc Intertyp means interaction type of backbone mainchain correlation:
5796 c 1 = SC...Ca...Ca...Ca
5797 c 2 = Ca...Ca...Ca...SC
5798 c 3 = SC...Ca...Ca...SCi
5800 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5801 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5802 & (itype(i-1).eq.ntyp1)))
5803 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5804 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5805 & .or.(itype(i).eq.ntyp1)))
5806 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5807 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5808 & (itype(i-3).eq.ntyp1)))) cycle
5809 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5810 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5812 do j=1,nterm_sccor(isccori,isccori1)
5813 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5814 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5815 cosphi=dcos(j*tauangle(intertyp,i))
5816 sinphi=dsin(j*tauangle(intertyp,i))
5817 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5818 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5820 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5821 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5823 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5824 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
5825 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
5826 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5827 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5833 c----------------------------------------------------------------------------
5834 subroutine multibody(ecorr)
5835 C This subroutine calculates multi-body contributions to energy following
5836 C the idea of Skolnick et al. If side chains I and J make a contact and
5837 C at the same time side chains I+1 and J+1 make a contact, an extra
5838 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5839 implicit real*8 (a-h,o-z)
5840 include 'DIMENSIONS'
5841 include 'COMMON.IOUNITS'
5842 include 'COMMON.DERIV'
5843 include 'COMMON.INTERACT'
5844 include 'COMMON.CONTACTS'
5845 double precision gx(3),gx1(3)
5848 C Set lprn=.true. for debugging
5852 write (iout,'(a)') 'Contact function values:'
5854 write (iout,'(i2,20(1x,i2,f10.5))')
5855 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5870 num_conti=num_cont(i)
5871 num_conti1=num_cont(i1)
5876 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5877 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5878 cd & ' ishift=',ishift
5879 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5880 C The system gains extra energy.
5881 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5882 endif ! j1==j+-ishift
5891 c------------------------------------------------------------------------------
5892 double precision function esccorr(i,j,k,l,jj,kk)
5893 implicit real*8 (a-h,o-z)
5894 include 'DIMENSIONS'
5895 include 'COMMON.IOUNITS'
5896 include 'COMMON.DERIV'
5897 include 'COMMON.INTERACT'
5898 include 'COMMON.CONTACTS'
5899 double precision gx(3),gx1(3)
5904 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5905 C Calculate the multi-body contribution to energy.
5906 C Calculate multi-body contributions to the gradient.
5907 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5908 cd & k,l,(gacont(m,kk,k),m=1,3)
5910 gx(m) =ekl*gacont(m,jj,i)
5911 gx1(m)=eij*gacont(m,kk,k)
5912 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5913 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5914 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5915 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5919 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5924 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5930 c------------------------------------------------------------------------------
5931 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5932 C This subroutine calculates multi-body contributions to hydrogen-bonding
5933 implicit real*8 (a-h,o-z)
5934 include 'DIMENSIONS'
5935 include 'COMMON.IOUNITS'
5938 parameter (max_cont=maxconts)
5939 parameter (max_dim=26)
5940 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5941 double precision zapas(max_dim,maxconts,max_fg_procs),
5942 & zapas_recv(max_dim,maxconts,max_fg_procs)
5943 common /przechowalnia/ zapas
5944 integer status(MPI_STATUS_SIZE),req(maxconts*2),
5945 & status_array(MPI_STATUS_SIZE,maxconts*2)
5947 include 'COMMON.SETUP'
5948 include 'COMMON.FFIELD'
5949 include 'COMMON.DERIV'
5950 include 'COMMON.INTERACT'
5951 include 'COMMON.CONTACTS'
5952 include 'COMMON.CONTROL'
5953 include 'COMMON.LOCAL'
5954 double precision gx(3),gx1(3),time00
5957 C Set lprn=.true. for debugging
5962 if (nfgtasks.le.1) goto 30
5964 write (iout,'(a)') 'Contact function values before RECEIVE:'
5966 write (iout,'(2i3,50(1x,i2,f5.2))')
5967 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5968 & j=1,num_cont_hb(i))
5972 do i=1,ntask_cont_from
5975 do i=1,ntask_cont_to
5978 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
5980 C Make the list of contacts to send to send to other procesors
5981 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
5983 do i=iturn3_start,iturn3_end
5984 c write (iout,*) "make contact list turn3",i," num_cont",
5986 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
5988 do i=iturn4_start,iturn4_end
5989 c write (iout,*) "make contact list turn4",i," num_cont",
5991 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
5995 c write (iout,*) "make contact list longrange",i,ii," num_cont",
5997 do j=1,num_cont_hb(i)
6000 iproc=iint_sent_local(k,jjc,ii)
6001 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6002 if (iproc.gt.0) then
6003 ncont_sent(iproc)=ncont_sent(iproc)+1
6004 nn=ncont_sent(iproc)
6006 zapas(2,nn,iproc)=jjc
6007 zapas(3,nn,iproc)=facont_hb(j,i)
6008 zapas(4,nn,iproc)=ees0p(j,i)
6009 zapas(5,nn,iproc)=ees0m(j,i)
6010 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6011 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6012 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6013 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6014 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6015 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6016 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6017 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6018 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6019 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6020 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6021 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6022 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6023 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6024 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6025 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6026 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6027 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6028 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6029 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6030 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6037 & "Numbers of contacts to be sent to other processors",
6038 & (ncont_sent(i),i=1,ntask_cont_to)
6039 write (iout,*) "Contacts sent"
6040 do ii=1,ntask_cont_to
6042 iproc=itask_cont_to(ii)
6043 write (iout,*) nn," contacts to processor",iproc,
6044 & " of CONT_TO_COMM group"
6046 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6054 CorrelID1=nfgtasks+fg_rank+1
6056 C Receive the numbers of needed contacts from other processors
6057 do ii=1,ntask_cont_from
6058 iproc=itask_cont_from(ii)
6060 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6061 & FG_COMM,req(ireq),IERR)
6063 c write (iout,*) "IRECV ended"
6065 C Send the number of contacts needed by other processors
6066 do ii=1,ntask_cont_to
6067 iproc=itask_cont_to(ii)
6069 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6070 & FG_COMM,req(ireq),IERR)
6072 c write (iout,*) "ISEND ended"
6073 c write (iout,*) "number of requests (nn)",ireq
6076 & call MPI_Waitall(ireq,req,status_array,ierr)
6078 c & "Numbers of contacts to be received from other processors",
6079 c & (ncont_recv(i),i=1,ntask_cont_from)
6083 do ii=1,ntask_cont_from
6084 iproc=itask_cont_from(ii)
6086 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6087 c & " of CONT_TO_COMM group"
6091 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6092 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6093 c write (iout,*) "ireq,req",ireq,req(ireq)
6096 C Send the contacts to processors that need them
6097 do ii=1,ntask_cont_to
6098 iproc=itask_cont_to(ii)
6100 c write (iout,*) nn," contacts to processor",iproc,
6101 c & " of CONT_TO_COMM group"
6104 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6105 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6106 c write (iout,*) "ireq,req",ireq,req(ireq)
6108 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6112 c write (iout,*) "number of requests (contacts)",ireq
6113 c write (iout,*) "req",(req(i),i=1,4)
6116 & call MPI_Waitall(ireq,req,status_array,ierr)
6117 do iii=1,ntask_cont_from
6118 iproc=itask_cont_from(iii)
6121 write (iout,*) "Received",nn," contacts from processor",iproc,
6122 & " of CONT_FROM_COMM group"
6125 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6130 ii=zapas_recv(1,i,iii)
6131 c Flag the received contacts to prevent double-counting
6132 jj=-zapas_recv(2,i,iii)
6133 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6135 nnn=num_cont_hb(ii)+1
6138 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6139 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6140 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6141 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6142 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6143 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6144 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6145 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6146 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6147 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6148 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6149 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6150 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6151 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6152 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6153 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6154 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6155 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6156 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6157 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6158 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6159 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6160 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6161 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6166 write (iout,'(a)') 'Contact function values after receive:'
6168 write (iout,'(2i3,50(1x,i3,f5.2))')
6169 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6170 & j=1,num_cont_hb(i))
6177 write (iout,'(a)') 'Contact function values:'
6179 write (iout,'(2i3,50(1x,i3,f5.2))')
6180 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6181 & j=1,num_cont_hb(i))
6185 C Remove the loop below after debugging !!!
6192 C Calculate the local-electrostatic correlation terms
6193 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6195 num_conti=num_cont_hb(i)
6196 num_conti1=num_cont_hb(i+1)
6203 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6204 c & ' jj=',jj,' kk=',kk
6205 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6206 & .or. j.lt.0 .and. j1.gt.0) .and.
6207 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6208 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6209 C The system gains extra energy.
6210 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6211 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6212 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6214 else if (j1.eq.j) then
6215 C Contacts I-J and I-(J+1) occur simultaneously.
6216 C The system loses extra energy.
6217 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6222 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6223 c & ' jj=',jj,' kk=',kk
6225 C Contacts I-J and (I+1)-J occur simultaneously.
6226 C The system loses extra energy.
6227 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6234 c------------------------------------------------------------------------------
6235 subroutine add_hb_contact(ii,jj,itask)
6236 implicit real*8 (a-h,o-z)
6237 include "DIMENSIONS"
6238 include "COMMON.IOUNITS"
6241 parameter (max_cont=maxconts)
6242 parameter (max_dim=26)
6243 include "COMMON.CONTACTS"
6244 double precision zapas(max_dim,maxconts,max_fg_procs),
6245 & zapas_recv(max_dim,maxconts,max_fg_procs)
6246 common /przechowalnia/ zapas
6247 integer i,j,ii,jj,iproc,itask(4),nn
6248 c write (iout,*) "itask",itask
6251 if (iproc.gt.0) then
6252 do j=1,num_cont_hb(ii)
6254 c write (iout,*) "i",ii," j",jj," jjc",jjc
6256 ncont_sent(iproc)=ncont_sent(iproc)+1
6257 nn=ncont_sent(iproc)
6258 zapas(1,nn,iproc)=ii
6259 zapas(2,nn,iproc)=jjc
6260 zapas(3,nn,iproc)=facont_hb(j,ii)
6261 zapas(4,nn,iproc)=ees0p(j,ii)
6262 zapas(5,nn,iproc)=ees0m(j,ii)
6263 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6264 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6265 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6266 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6267 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6268 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6269 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6270 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6271 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6272 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6273 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6274 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6275 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6276 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6277 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6278 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6279 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6280 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6281 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6282 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6283 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6291 c------------------------------------------------------------------------------
6292 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6294 C This subroutine calculates multi-body contributions to hydrogen-bonding
6295 implicit real*8 (a-h,o-z)
6296 include 'DIMENSIONS'
6297 include 'COMMON.IOUNITS'
6300 parameter (max_cont=maxconts)
6301 parameter (max_dim=70)
6302 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6303 double precision zapas(max_dim,maxconts,max_fg_procs),
6304 & zapas_recv(max_dim,maxconts,max_fg_procs)
6305 common /przechowalnia/ zapas
6306 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6307 & status_array(MPI_STATUS_SIZE,maxconts*2)
6309 include 'COMMON.SETUP'
6310 include 'COMMON.FFIELD'
6311 include 'COMMON.DERIV'
6312 include 'COMMON.LOCAL'
6313 include 'COMMON.INTERACT'
6314 include 'COMMON.CONTACTS'
6315 include 'COMMON.CHAIN'
6316 include 'COMMON.CONTROL'
6317 double precision gx(3),gx1(3)
6318 integer num_cont_hb_old(maxres)
6320 double precision eello4,eello5,eelo6,eello_turn6
6321 external eello4,eello5,eello6,eello_turn6
6322 C Set lprn=.true. for debugging
6327 num_cont_hb_old(i)=num_cont_hb(i)
6331 if (nfgtasks.le.1) goto 30
6333 write (iout,'(a)') 'Contact function values before RECEIVE:'
6335 write (iout,'(2i3,50(1x,i2,f5.2))')
6336 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6337 & j=1,num_cont_hb(i))
6341 do i=1,ntask_cont_from
6344 do i=1,ntask_cont_to
6347 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6349 C Make the list of contacts to send to send to other procesors
6350 do i=iturn3_start,iturn3_end
6351 c write (iout,*) "make contact list turn3",i," num_cont",
6353 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6355 do i=iturn4_start,iturn4_end
6356 c write (iout,*) "make contact list turn4",i," num_cont",
6358 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6362 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6364 do j=1,num_cont_hb(i)
6367 iproc=iint_sent_local(k,jjc,ii)
6368 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6369 if (iproc.ne.0) then
6370 ncont_sent(iproc)=ncont_sent(iproc)+1
6371 nn=ncont_sent(iproc)
6373 zapas(2,nn,iproc)=jjc
6374 zapas(3,nn,iproc)=d_cont(j,i)
6378 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6383 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6391 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6402 & "Numbers of contacts to be sent to other processors",
6403 & (ncont_sent(i),i=1,ntask_cont_to)
6404 write (iout,*) "Contacts sent"
6405 do ii=1,ntask_cont_to
6407 iproc=itask_cont_to(ii)
6408 write (iout,*) nn," contacts to processor",iproc,
6409 & " of CONT_TO_COMM group"
6411 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6419 CorrelID1=nfgtasks+fg_rank+1
6421 C Receive the numbers of needed contacts from other processors
6422 do ii=1,ntask_cont_from
6423 iproc=itask_cont_from(ii)
6425 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6426 & FG_COMM,req(ireq),IERR)
6428 c write (iout,*) "IRECV ended"
6430 C Send the number of contacts needed by other processors
6431 do ii=1,ntask_cont_to
6432 iproc=itask_cont_to(ii)
6434 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6435 & FG_COMM,req(ireq),IERR)
6437 c write (iout,*) "ISEND ended"
6438 c write (iout,*) "number of requests (nn)",ireq
6441 & call MPI_Waitall(ireq,req,status_array,ierr)
6443 c & "Numbers of contacts to be received from other processors",
6444 c & (ncont_recv(i),i=1,ntask_cont_from)
6448 do ii=1,ntask_cont_from
6449 iproc=itask_cont_from(ii)
6451 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6452 c & " of CONT_TO_COMM group"
6456 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6457 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6458 c write (iout,*) "ireq,req",ireq,req(ireq)
6461 C Send the contacts to processors that need them
6462 do ii=1,ntask_cont_to
6463 iproc=itask_cont_to(ii)
6465 c write (iout,*) nn," contacts to processor",iproc,
6466 c & " of CONT_TO_COMM group"
6469 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6470 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6471 c write (iout,*) "ireq,req",ireq,req(ireq)
6473 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6477 c write (iout,*) "number of requests (contacts)",ireq
6478 c write (iout,*) "req",(req(i),i=1,4)
6481 & call MPI_Waitall(ireq,req,status_array,ierr)
6482 do iii=1,ntask_cont_from
6483 iproc=itask_cont_from(iii)
6486 write (iout,*) "Received",nn," contacts from processor",iproc,
6487 & " of CONT_FROM_COMM group"
6490 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6495 ii=zapas_recv(1,i,iii)
6496 c Flag the received contacts to prevent double-counting
6497 jj=-zapas_recv(2,i,iii)
6498 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6500 nnn=num_cont_hb(ii)+1
6503 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6507 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6512 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6520 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6529 write (iout,'(a)') 'Contact function values after receive:'
6531 write (iout,'(2i3,50(1x,i3,5f6.3))')
6532 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6533 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6540 write (iout,'(a)') 'Contact function values:'
6542 write (iout,'(2i3,50(1x,i2,5f6.3))')
6543 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6544 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6550 C Remove the loop below after debugging !!!
6557 C Calculate the dipole-dipole interaction energies
6558 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6559 do i=iatel_s,iatel_e+1
6560 num_conti=num_cont_hb(i)
6569 C Calculate the local-electrostatic correlation terms
6570 c write (iout,*) "gradcorr5 in eello5 before loop"
6572 c write (iout,'(i5,3f10.5)')
6573 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6575 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6576 c write (iout,*) "corr loop i",i
6578 num_conti=num_cont_hb(i)
6579 num_conti1=num_cont_hb(i+1)
6586 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6587 c & ' jj=',jj,' kk=',kk
6588 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6589 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6590 & .or. j.lt.0 .and. j1.gt.0) .and.
6591 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6592 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6593 C The system gains extra energy.
6595 sqd1=dsqrt(d_cont(jj,i))
6596 sqd2=dsqrt(d_cont(kk,i1))
6597 sred_geom = sqd1*sqd2
6598 IF (sred_geom.lt.cutoff_corr) THEN
6599 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6601 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6602 cd & ' jj=',jj,' kk=',kk
6603 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6604 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6606 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6607 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6610 cd write (iout,*) 'sred_geom=',sred_geom,
6611 cd & ' ekont=',ekont,' fprim=',fprimcont,
6612 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6613 cd write (iout,*) "g_contij",g_contij
6614 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6615 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6616 call calc_eello(i,jp,i+1,jp1,jj,kk)
6617 if (wcorr4.gt.0.0d0)
6618 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6619 if (energy_dec.and.wcorr4.gt.0.0d0)
6620 1 write (iout,'(a6,4i5,0pf7.3)')
6621 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6622 c write (iout,*) "gradcorr5 before eello5"
6624 c write (iout,'(i5,3f10.5)')
6625 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6627 if (wcorr5.gt.0.0d0)
6628 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6629 c write (iout,*) "gradcorr5 after eello5"
6631 c write (iout,'(i5,3f10.5)')
6632 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6634 if (energy_dec.and.wcorr5.gt.0.0d0)
6635 1 write (iout,'(a6,4i5,0pf7.3)')
6636 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6637 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6638 cd write(2,*)'ijkl',i,jp,i+1,jp1
6639 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6640 & .or. wturn6.eq.0.0d0))then
6641 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6642 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6643 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6644 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6645 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6646 cd & 'ecorr6=',ecorr6
6647 cd write (iout,'(4e15.5)') sred_geom,
6648 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6649 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6650 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6651 else if (wturn6.gt.0.0d0
6652 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6653 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6654 eturn6=eturn6+eello_turn6(i,jj,kk)
6655 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6656 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6657 cd write (2,*) 'multibody_eello:eturn6',eturn6
6666 num_cont_hb(i)=num_cont_hb_old(i)
6668 c write (iout,*) "gradcorr5 in eello5"
6670 c write (iout,'(i5,3f10.5)')
6671 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6675 c------------------------------------------------------------------------------
6676 subroutine add_hb_contact_eello(ii,jj,itask)
6677 implicit real*8 (a-h,o-z)
6678 include "DIMENSIONS"
6679 include "COMMON.IOUNITS"
6682 parameter (max_cont=maxconts)
6683 parameter (max_dim=70)
6684 include "COMMON.CONTACTS"
6685 double precision zapas(max_dim,maxconts,max_fg_procs),
6686 & zapas_recv(max_dim,maxconts,max_fg_procs)
6687 common /przechowalnia/ zapas
6688 integer i,j,ii,jj,iproc,itask(4),nn
6689 c write (iout,*) "itask",itask
6692 if (iproc.gt.0) then
6693 do j=1,num_cont_hb(ii)
6695 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6697 ncont_sent(iproc)=ncont_sent(iproc)+1
6698 nn=ncont_sent(iproc)
6699 zapas(1,nn,iproc)=ii
6700 zapas(2,nn,iproc)=jjc
6701 zapas(3,nn,iproc)=d_cont(j,ii)
6705 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6710 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6718 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6730 c------------------------------------------------------------------------------
6731 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6732 implicit real*8 (a-h,o-z)
6733 include 'DIMENSIONS'
6734 include 'COMMON.IOUNITS'
6735 include 'COMMON.DERIV'
6736 include 'COMMON.INTERACT'
6737 include 'COMMON.CONTACTS'
6738 double precision gx(3),gx1(3)
6748 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6749 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6750 C Following 4 lines for diagnostics.
6755 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6756 c & 'Contacts ',i,j,
6757 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6758 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6760 C Calculate the multi-body contribution to energy.
6761 c ecorr=ecorr+ekont*ees
6762 C Calculate multi-body contributions to the gradient.
6763 coeffpees0pij=coeffp*ees0pij
6764 coeffmees0mij=coeffm*ees0mij
6765 coeffpees0pkl=coeffp*ees0pkl
6766 coeffmees0mkl=coeffm*ees0mkl
6768 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6769 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6770 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6771 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6772 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6773 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6774 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6775 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6776 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6777 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6778 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6779 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6780 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6781 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6782 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6783 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6784 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6785 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6786 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6787 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6788 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6789 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6790 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6791 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6792 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6797 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6798 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6799 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6800 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6805 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6806 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6807 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6808 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6811 c write (iout,*) "ehbcorr",ekont*ees
6816 C---------------------------------------------------------------------------
6817 subroutine dipole(i,j,jj)
6818 implicit real*8 (a-h,o-z)
6819 include 'DIMENSIONS'
6820 include 'COMMON.IOUNITS'
6821 include 'COMMON.CHAIN'
6822 include 'COMMON.FFIELD'
6823 include 'COMMON.DERIV'
6824 include 'COMMON.INTERACT'
6825 include 'COMMON.CONTACTS'
6826 include 'COMMON.TORSION'
6827 include 'COMMON.VAR'
6828 include 'COMMON.GEO'
6829 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6831 iti1 = itortyp(itype(i+1))
6832 if (j.lt.nres-1) then
6833 itj1 = itortyp(itype(j+1))
6838 dipi(iii,1)=Ub2(iii,i)
6839 dipderi(iii)=Ub2der(iii,i)
6840 dipi(iii,2)=b1(iii,iti1)
6841 dipj(iii,1)=Ub2(iii,j)
6842 dipderj(iii)=Ub2der(iii,j)
6843 dipj(iii,2)=b1(iii,itj1)
6847 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6850 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6857 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6861 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6866 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6867 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6869 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6871 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6873 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6878 C---------------------------------------------------------------------------
6879 subroutine calc_eello(i,j,k,l,jj,kk)
6881 C This subroutine computes matrices and vectors needed to calculate
6882 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6884 implicit real*8 (a-h,o-z)
6885 include 'DIMENSIONS'
6886 include 'COMMON.IOUNITS'
6887 include 'COMMON.CHAIN'
6888 include 'COMMON.DERIV'
6889 include 'COMMON.INTERACT'
6890 include 'COMMON.CONTACTS'
6891 include 'COMMON.TORSION'
6892 include 'COMMON.VAR'
6893 include 'COMMON.GEO'
6894 include 'COMMON.FFIELD'
6895 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6896 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6899 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6900 cd & ' jj=',jj,' kk=',kk
6901 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6902 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6903 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6906 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6907 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6910 call transpose2(aa1(1,1),aa1t(1,1))
6911 call transpose2(aa2(1,1),aa2t(1,1))
6914 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6915 & aa1tder(1,1,lll,kkk))
6916 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6917 & aa2tder(1,1,lll,kkk))
6921 C parallel orientation of the two CA-CA-CA frames.
6923 iti=itortyp(itype(i))
6927 itk1=itortyp(itype(k+1))
6928 itj=itortyp(itype(j))
6929 if (l.lt.nres-1) then
6930 itl1=itortyp(itype(l+1))
6934 C A1 kernel(j+1) A2T
6936 cd write (iout,'(3f10.5,5x,3f10.5)')
6937 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6939 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6940 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6941 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6942 C Following matrices are needed only for 6-th order cumulants
6943 IF (wcorr6.gt.0.0d0) THEN
6944 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6945 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6946 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6947 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6948 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6949 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6950 & ADtEAderx(1,1,1,1,1,1))
6952 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6953 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6954 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6955 & ADtEA1derx(1,1,1,1,1,1))
6957 C End 6-th order cumulants
6960 cd write (2,*) 'In calc_eello6'
6962 cd write (2,*) 'iii=',iii
6964 cd write (2,*) 'kkk=',kkk
6966 cd write (2,'(3(2f10.5),5x)')
6967 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6972 call transpose2(EUgder(1,1,k),auxmat(1,1))
6973 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6974 call transpose2(EUg(1,1,k),auxmat(1,1))
6975 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6976 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6980 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6981 & EAEAderx(1,1,lll,kkk,iii,1))
6985 C A1T kernel(i+1) A2
6986 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6987 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6988 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6989 C Following matrices are needed only for 6-th order cumulants
6990 IF (wcorr6.gt.0.0d0) THEN
6991 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6992 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6993 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6994 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6995 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6996 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6997 & ADtEAderx(1,1,1,1,1,2))
6998 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6999 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7000 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7001 & ADtEA1derx(1,1,1,1,1,2))
7003 C End 6-th order cumulants
7004 call transpose2(EUgder(1,1,l),auxmat(1,1))
7005 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7006 call transpose2(EUg(1,1,l),auxmat(1,1))
7007 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7008 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7012 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7013 & EAEAderx(1,1,lll,kkk,iii,2))
7018 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7019 C They are needed only when the fifth- or the sixth-order cumulants are
7021 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7022 call transpose2(AEA(1,1,1),auxmat(1,1))
7023 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7024 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7025 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7026 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7027 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7028 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7029 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7030 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7031 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7032 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7033 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7034 call transpose2(AEA(1,1,2),auxmat(1,1))
7035 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7036 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7037 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7038 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7039 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7040 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7041 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7042 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7043 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7044 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7045 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7046 C Calculate the Cartesian derivatives of the vectors.
7050 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7051 call matvec2(auxmat(1,1),b1(1,iti),
7052 & AEAb1derx(1,lll,kkk,iii,1,1))
7053 call matvec2(auxmat(1,1),Ub2(1,i),
7054 & AEAb2derx(1,lll,kkk,iii,1,1))
7055 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7056 & AEAb1derx(1,lll,kkk,iii,2,1))
7057 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7058 & AEAb2derx(1,lll,kkk,iii,2,1))
7059 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7060 call matvec2(auxmat(1,1),b1(1,itj),
7061 & AEAb1derx(1,lll,kkk,iii,1,2))
7062 call matvec2(auxmat(1,1),Ub2(1,j),
7063 & AEAb2derx(1,lll,kkk,iii,1,2))
7064 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7065 & AEAb1derx(1,lll,kkk,iii,2,2))
7066 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7067 & AEAb2derx(1,lll,kkk,iii,2,2))
7074 C Antiparallel orientation of the two CA-CA-CA frames.
7076 iti=itortyp(itype(i))
7080 itk1=itortyp(itype(k+1))
7081 itl=itortyp(itype(l))
7082 itj=itortyp(itype(j))
7083 if (j.lt.nres-1) then
7084 itj1=itortyp(itype(j+1))
7088 C A2 kernel(j-1)T A1T
7089 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7090 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7091 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7092 C Following matrices are needed only for 6-th order cumulants
7093 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7094 & j.eq.i+4 .and. l.eq.i+3)) THEN
7095 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7096 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7097 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7098 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7099 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7100 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7101 & ADtEAderx(1,1,1,1,1,1))
7102 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7103 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7104 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7105 & ADtEA1derx(1,1,1,1,1,1))
7107 C End 6-th order cumulants
7108 call transpose2(EUgder(1,1,k),auxmat(1,1))
7109 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7110 call transpose2(EUg(1,1,k),auxmat(1,1))
7111 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7112 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7116 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7117 & EAEAderx(1,1,lll,kkk,iii,1))
7121 C A2T kernel(i+1)T A1
7122 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7123 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7124 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7125 C Following matrices are needed only for 6-th order cumulants
7126 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7127 & j.eq.i+4 .and. l.eq.i+3)) THEN
7128 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7129 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7130 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7131 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7132 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7133 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7134 & ADtEAderx(1,1,1,1,1,2))
7135 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7136 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7137 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7138 & ADtEA1derx(1,1,1,1,1,2))
7140 C End 6-th order cumulants
7141 call transpose2(EUgder(1,1,j),auxmat(1,1))
7142 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7143 call transpose2(EUg(1,1,j),auxmat(1,1))
7144 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7145 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7149 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7150 & EAEAderx(1,1,lll,kkk,iii,2))
7155 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7156 C They are needed only when the fifth- or the sixth-order cumulants are
7158 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7159 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7160 call transpose2(AEA(1,1,1),auxmat(1,1))
7161 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7162 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7163 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7164 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7165 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7166 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7167 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7168 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7169 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7170 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7171 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7172 call transpose2(AEA(1,1,2),auxmat(1,1))
7173 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7174 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7175 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7176 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7177 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7178 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7179 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7180 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7181 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7182 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7183 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7184 C Calculate the Cartesian derivatives of the vectors.
7188 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7189 call matvec2(auxmat(1,1),b1(1,iti),
7190 & AEAb1derx(1,lll,kkk,iii,1,1))
7191 call matvec2(auxmat(1,1),Ub2(1,i),
7192 & AEAb2derx(1,lll,kkk,iii,1,1))
7193 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7194 & AEAb1derx(1,lll,kkk,iii,2,1))
7195 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7196 & AEAb2derx(1,lll,kkk,iii,2,1))
7197 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7198 call matvec2(auxmat(1,1),b1(1,itl),
7199 & AEAb1derx(1,lll,kkk,iii,1,2))
7200 call matvec2(auxmat(1,1),Ub2(1,l),
7201 & AEAb2derx(1,lll,kkk,iii,1,2))
7202 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7203 & AEAb1derx(1,lll,kkk,iii,2,2))
7204 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7205 & AEAb2derx(1,lll,kkk,iii,2,2))
7214 C---------------------------------------------------------------------------
7215 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7216 & KK,KKderg,AKA,AKAderg,AKAderx)
7220 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7221 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7222 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7227 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7229 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7232 cd if (lprn) write (2,*) 'In kernel'
7234 cd if (lprn) write (2,*) 'kkk=',kkk
7236 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7237 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7239 cd write (2,*) 'lll=',lll
7240 cd write (2,*) 'iii=1'
7242 cd write (2,'(3(2f10.5),5x)')
7243 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7246 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7247 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7249 cd write (2,*) 'lll=',lll
7250 cd write (2,*) 'iii=2'
7252 cd write (2,'(3(2f10.5),5x)')
7253 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7260 C---------------------------------------------------------------------------
7261 double precision function eello4(i,j,k,l,jj,kk)
7262 implicit real*8 (a-h,o-z)
7263 include 'DIMENSIONS'
7264 include 'COMMON.IOUNITS'
7265 include 'COMMON.CHAIN'
7266 include 'COMMON.DERIV'
7267 include 'COMMON.INTERACT'
7268 include 'COMMON.CONTACTS'
7269 include 'COMMON.TORSION'
7270 include 'COMMON.VAR'
7271 include 'COMMON.GEO'
7272 double precision pizda(2,2),ggg1(3),ggg2(3)
7273 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7277 cd print *,'eello4:',i,j,k,l,jj,kk
7278 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7279 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7280 cold eij=facont_hb(jj,i)
7281 cold ekl=facont_hb(kk,k)
7283 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7284 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7285 gcorr_loc(k-1)=gcorr_loc(k-1)
7286 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7288 gcorr_loc(l-1)=gcorr_loc(l-1)
7289 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7291 gcorr_loc(j-1)=gcorr_loc(j-1)
7292 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7297 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7298 & -EAEAderx(2,2,lll,kkk,iii,1)
7299 cd derx(lll,kkk,iii)=0.0d0
7303 cd gcorr_loc(l-1)=0.0d0
7304 cd gcorr_loc(j-1)=0.0d0
7305 cd gcorr_loc(k-1)=0.0d0
7307 cd write (iout,*)'Contacts have occurred for peptide groups',
7308 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7309 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7310 if (j.lt.nres-1) then
7317 if (l.lt.nres-1) then
7325 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7326 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7327 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7328 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7329 cgrad ghalf=0.5d0*ggg1(ll)
7330 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7331 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7332 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7333 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7334 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7335 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7336 cgrad ghalf=0.5d0*ggg2(ll)
7337 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7338 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7339 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7340 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7341 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7342 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7346 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7351 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7356 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7361 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7365 cd write (2,*) iii,gcorr_loc(iii)
7368 cd write (2,*) 'ekont',ekont
7369 cd write (iout,*) 'eello4',ekont*eel4
7372 C---------------------------------------------------------------------------
7373 double precision function eello5(i,j,k,l,jj,kk)
7374 implicit real*8 (a-h,o-z)
7375 include 'DIMENSIONS'
7376 include 'COMMON.IOUNITS'
7377 include 'COMMON.CHAIN'
7378 include 'COMMON.DERIV'
7379 include 'COMMON.INTERACT'
7380 include 'COMMON.CONTACTS'
7381 include 'COMMON.TORSION'
7382 include 'COMMON.VAR'
7383 include 'COMMON.GEO'
7384 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7385 double precision ggg1(3),ggg2(3)
7386 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7391 C /l\ / \ \ / \ / \ / C
7392 C / \ / \ \ / \ / \ / C
7393 C j| o |l1 | o | o| o | | o |o C
7394 C \ |/k\| |/ \| / |/ \| |/ \| C
7395 C \i/ \ / \ / / \ / \ C
7397 C (I) (II) (III) (IV) C
7399 C eello5_1 eello5_2 eello5_3 eello5_4 C
7401 C Antiparallel chains C
7404 C /j\ / \ \ / \ / \ / C
7405 C / \ / \ \ / \ / \ / C
7406 C j1| o |l | o | o| o | | o |o C
7407 C \ |/k\| |/ \| / |/ \| |/ \| C
7408 C \i/ \ / \ / / \ / \ C
7410 C (I) (II) (III) (IV) C
7412 C eello5_1 eello5_2 eello5_3 eello5_4 C
7414 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7416 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7417 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7422 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7424 itk=itortyp(itype(k))
7425 itl=itortyp(itype(l))
7426 itj=itortyp(itype(j))
7431 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7432 cd & eel5_3_num,eel5_4_num)
7436 derx(lll,kkk,iii)=0.0d0
7440 cd eij=facont_hb(jj,i)
7441 cd ekl=facont_hb(kk,k)
7443 cd write (iout,*)'Contacts have occurred for peptide groups',
7444 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7446 C Contribution from the graph I.
7447 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7448 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7449 call transpose2(EUg(1,1,k),auxmat(1,1))
7450 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7451 vv(1)=pizda(1,1)-pizda(2,2)
7452 vv(2)=pizda(1,2)+pizda(2,1)
7453 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7454 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7455 C Explicit gradient in virtual-dihedral angles.
7456 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7457 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7458 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7459 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7460 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7461 vv(1)=pizda(1,1)-pizda(2,2)
7462 vv(2)=pizda(1,2)+pizda(2,1)
7463 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7464 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7465 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7466 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7467 vv(1)=pizda(1,1)-pizda(2,2)
7468 vv(2)=pizda(1,2)+pizda(2,1)
7470 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7471 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7472 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7474 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7475 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7476 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7478 C Cartesian gradient
7482 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7484 vv(1)=pizda(1,1)-pizda(2,2)
7485 vv(2)=pizda(1,2)+pizda(2,1)
7486 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7487 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7488 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7494 C Contribution from graph II
7495 call transpose2(EE(1,1,itk),auxmat(1,1))
7496 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7497 vv(1)=pizda(1,1)+pizda(2,2)
7498 vv(2)=pizda(2,1)-pizda(1,2)
7499 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7500 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7501 C Explicit gradient in virtual-dihedral angles.
7502 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7503 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7504 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7505 vv(1)=pizda(1,1)+pizda(2,2)
7506 vv(2)=pizda(2,1)-pizda(1,2)
7508 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7509 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7510 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7512 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7513 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7514 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7516 C Cartesian gradient
7520 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7522 vv(1)=pizda(1,1)+pizda(2,2)
7523 vv(2)=pizda(2,1)-pizda(1,2)
7524 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7525 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7526 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7534 C Parallel orientation
7535 C Contribution from graph III
7536 call transpose2(EUg(1,1,l),auxmat(1,1))
7537 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7538 vv(1)=pizda(1,1)-pizda(2,2)
7539 vv(2)=pizda(1,2)+pizda(2,1)
7540 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7541 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7542 C Explicit gradient in virtual-dihedral angles.
7543 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7544 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7545 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7546 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7547 vv(1)=pizda(1,1)-pizda(2,2)
7548 vv(2)=pizda(1,2)+pizda(2,1)
7549 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7550 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7551 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7552 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7553 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7554 vv(1)=pizda(1,1)-pizda(2,2)
7555 vv(2)=pizda(1,2)+pizda(2,1)
7556 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7557 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7558 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7559 C Cartesian gradient
7563 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7565 vv(1)=pizda(1,1)-pizda(2,2)
7566 vv(2)=pizda(1,2)+pizda(2,1)
7567 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7568 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7569 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7574 C Contribution from graph IV
7576 call transpose2(EE(1,1,itl),auxmat(1,1))
7577 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7578 vv(1)=pizda(1,1)+pizda(2,2)
7579 vv(2)=pizda(2,1)-pizda(1,2)
7580 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7581 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7582 C Explicit gradient in virtual-dihedral angles.
7583 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7584 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7585 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7586 vv(1)=pizda(1,1)+pizda(2,2)
7587 vv(2)=pizda(2,1)-pizda(1,2)
7588 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7589 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7590 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7591 C Cartesian gradient
7595 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7597 vv(1)=pizda(1,1)+pizda(2,2)
7598 vv(2)=pizda(2,1)-pizda(1,2)
7599 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7600 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7601 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7606 C Antiparallel orientation
7607 C Contribution from graph III
7609 call transpose2(EUg(1,1,j),auxmat(1,1))
7610 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7611 vv(1)=pizda(1,1)-pizda(2,2)
7612 vv(2)=pizda(1,2)+pizda(2,1)
7613 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7614 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7615 C Explicit gradient in virtual-dihedral angles.
7616 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7617 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7618 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7619 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7620 vv(1)=pizda(1,1)-pizda(2,2)
7621 vv(2)=pizda(1,2)+pizda(2,1)
7622 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7623 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7624 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7625 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7626 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7627 vv(1)=pizda(1,1)-pizda(2,2)
7628 vv(2)=pizda(1,2)+pizda(2,1)
7629 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7630 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7631 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7632 C Cartesian gradient
7636 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7638 vv(1)=pizda(1,1)-pizda(2,2)
7639 vv(2)=pizda(1,2)+pizda(2,1)
7640 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7641 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7642 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7647 C Contribution from graph IV
7649 call transpose2(EE(1,1,itj),auxmat(1,1))
7650 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7651 vv(1)=pizda(1,1)+pizda(2,2)
7652 vv(2)=pizda(2,1)-pizda(1,2)
7653 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7654 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7655 C Explicit gradient in virtual-dihedral angles.
7656 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7657 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7658 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7659 vv(1)=pizda(1,1)+pizda(2,2)
7660 vv(2)=pizda(2,1)-pizda(1,2)
7661 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7662 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7663 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7664 C Cartesian gradient
7668 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7670 vv(1)=pizda(1,1)+pizda(2,2)
7671 vv(2)=pizda(2,1)-pizda(1,2)
7672 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7673 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7674 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7680 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7681 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7682 cd write (2,*) 'ijkl',i,j,k,l
7683 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7684 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7686 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7687 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7688 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7689 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7690 if (j.lt.nres-1) then
7697 if (l.lt.nres-1) then
7707 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7708 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7709 C summed up outside the subrouine as for the other subroutines
7710 C handling long-range interactions. The old code is commented out
7711 C with "cgrad" to keep track of changes.
7713 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7714 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7715 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7716 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7717 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7718 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7719 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7720 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7721 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7722 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7724 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7725 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7726 cgrad ghalf=0.5d0*ggg1(ll)
7728 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7729 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7730 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7731 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7732 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7733 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7734 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7735 cgrad ghalf=0.5d0*ggg2(ll)
7737 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7738 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7739 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7740 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7741 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7742 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7747 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7748 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7753 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7754 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7760 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7765 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7769 cd write (2,*) iii,g_corr5_loc(iii)
7772 cd write (2,*) 'ekont',ekont
7773 cd write (iout,*) 'eello5',ekont*eel5
7776 c--------------------------------------------------------------------------
7777 double precision function eello6(i,j,k,l,jj,kk)
7778 implicit real*8 (a-h,o-z)
7779 include 'DIMENSIONS'
7780 include 'COMMON.IOUNITS'
7781 include 'COMMON.CHAIN'
7782 include 'COMMON.DERIV'
7783 include 'COMMON.INTERACT'
7784 include 'COMMON.CONTACTS'
7785 include 'COMMON.TORSION'
7786 include 'COMMON.VAR'
7787 include 'COMMON.GEO'
7788 include 'COMMON.FFIELD'
7789 double precision ggg1(3),ggg2(3)
7790 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7795 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7803 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7804 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7808 derx(lll,kkk,iii)=0.0d0
7812 cd eij=facont_hb(jj,i)
7813 cd ekl=facont_hb(kk,k)
7819 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7820 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7821 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7822 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7823 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7824 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7826 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7827 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7828 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7829 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7830 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7831 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7835 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7837 C If turn contributions are considered, they will be handled separately.
7838 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7839 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7840 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7841 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7842 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7843 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7844 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7846 if (j.lt.nres-1) then
7853 if (l.lt.nres-1) then
7861 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7862 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7863 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7864 cgrad ghalf=0.5d0*ggg1(ll)
7866 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7867 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7868 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7869 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7870 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7871 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7872 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7873 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7874 cgrad ghalf=0.5d0*ggg2(ll)
7875 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7877 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7878 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7879 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7880 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7881 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7882 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7887 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7888 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7893 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7894 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7900 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7905 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7909 cd write (2,*) iii,g_corr6_loc(iii)
7912 cd write (2,*) 'ekont',ekont
7913 cd write (iout,*) 'eello6',ekont*eel6
7916 c--------------------------------------------------------------------------
7917 double precision function eello6_graph1(i,j,k,l,imat,swap)
7918 implicit real*8 (a-h,o-z)
7919 include 'DIMENSIONS'
7920 include 'COMMON.IOUNITS'
7921 include 'COMMON.CHAIN'
7922 include 'COMMON.DERIV'
7923 include 'COMMON.INTERACT'
7924 include 'COMMON.CONTACTS'
7925 include 'COMMON.TORSION'
7926 include 'COMMON.VAR'
7927 include 'COMMON.GEO'
7928 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7932 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7934 C Parallel Antiparallel C
7940 C \ j|/k\| / \ |/k\|l / C
7945 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7946 itk=itortyp(itype(k))
7947 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7948 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7949 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7950 call transpose2(EUgC(1,1,k),auxmat(1,1))
7951 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7952 vv1(1)=pizda1(1,1)-pizda1(2,2)
7953 vv1(2)=pizda1(1,2)+pizda1(2,1)
7954 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7955 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7956 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7957 s5=scalar2(vv(1),Dtobr2(1,i))
7958 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7959 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7960 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7961 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7962 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7963 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7964 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7965 & +scalar2(vv(1),Dtobr2der(1,i)))
7966 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7967 vv1(1)=pizda1(1,1)-pizda1(2,2)
7968 vv1(2)=pizda1(1,2)+pizda1(2,1)
7969 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7970 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7972 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7973 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7974 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7975 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7976 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7978 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7979 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7980 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7981 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7982 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7984 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7985 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7986 vv1(1)=pizda1(1,1)-pizda1(2,2)
7987 vv1(2)=pizda1(1,2)+pizda1(2,1)
7988 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7989 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7990 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7991 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8000 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8001 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8002 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8003 call transpose2(EUgC(1,1,k),auxmat(1,1))
8004 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8006 vv1(1)=pizda1(1,1)-pizda1(2,2)
8007 vv1(2)=pizda1(1,2)+pizda1(2,1)
8008 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8009 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8010 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8011 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8012 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8013 s5=scalar2(vv(1),Dtobr2(1,i))
8014 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8020 c----------------------------------------------------------------------------
8021 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8022 implicit real*8 (a-h,o-z)
8023 include 'DIMENSIONS'
8024 include 'COMMON.IOUNITS'
8025 include 'COMMON.CHAIN'
8026 include 'COMMON.DERIV'
8027 include 'COMMON.INTERACT'
8028 include 'COMMON.CONTACTS'
8029 include 'COMMON.TORSION'
8030 include 'COMMON.VAR'
8031 include 'COMMON.GEO'
8033 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8034 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8037 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8039 C Parallel Antiparallel C
8045 C \ j|/k\| \ |/k\|l C
8050 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8051 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8052 C AL 7/4/01 s1 would occur in the sixth-order moment,
8053 C but not in a cluster cumulant
8055 s1=dip(1,jj,i)*dip(1,kk,k)
8057 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8058 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8059 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8060 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8061 call transpose2(EUg(1,1,k),auxmat(1,1))
8062 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8063 vv(1)=pizda(1,1)-pizda(2,2)
8064 vv(2)=pizda(1,2)+pizda(2,1)
8065 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8066 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8068 eello6_graph2=-(s1+s2+s3+s4)
8070 eello6_graph2=-(s2+s3+s4)
8073 C Derivatives in gamma(i-1)
8076 s1=dipderg(1,jj,i)*dip(1,kk,k)
8078 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8079 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8080 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8081 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8083 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8085 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8087 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8089 C Derivatives in gamma(k-1)
8091 s1=dip(1,jj,i)*dipderg(1,kk,k)
8093 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8094 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8095 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8096 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8097 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8098 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8099 vv(1)=pizda(1,1)-pizda(2,2)
8100 vv(2)=pizda(1,2)+pizda(2,1)
8101 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8103 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8105 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8107 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8108 C Derivatives in gamma(j-1) or gamma(l-1)
8111 s1=dipderg(3,jj,i)*dip(1,kk,k)
8113 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8114 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8115 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8116 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8117 vv(1)=pizda(1,1)-pizda(2,2)
8118 vv(2)=pizda(1,2)+pizda(2,1)
8119 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8122 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8124 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8127 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8128 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8130 C Derivatives in gamma(l-1) or gamma(j-1)
8133 s1=dip(1,jj,i)*dipderg(3,kk,k)
8135 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8136 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8137 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8138 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8139 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8140 vv(1)=pizda(1,1)-pizda(2,2)
8141 vv(2)=pizda(1,2)+pizda(2,1)
8142 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8145 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8147 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8150 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8151 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8153 C Cartesian derivatives.
8155 write (2,*) 'In eello6_graph2'
8157 write (2,*) 'iii=',iii
8159 write (2,*) 'kkk=',kkk
8161 write (2,'(3(2f10.5),5x)')
8162 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8172 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8174 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8177 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8179 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8180 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8182 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8183 call transpose2(EUg(1,1,k),auxmat(1,1))
8184 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8186 vv(1)=pizda(1,1)-pizda(2,2)
8187 vv(2)=pizda(1,2)+pizda(2,1)
8188 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8189 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8191 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8193 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8196 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8198 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8205 c----------------------------------------------------------------------------
8206 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8207 implicit real*8 (a-h,o-z)
8208 include 'DIMENSIONS'
8209 include 'COMMON.IOUNITS'
8210 include 'COMMON.CHAIN'
8211 include 'COMMON.DERIV'
8212 include 'COMMON.INTERACT'
8213 include 'COMMON.CONTACTS'
8214 include 'COMMON.TORSION'
8215 include 'COMMON.VAR'
8216 include 'COMMON.GEO'
8217 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8219 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8221 C Parallel Antiparallel C
8227 C j|/k\| / |/k\|l / C
8232 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8234 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8235 C energy moment and not to the cluster cumulant.
8236 iti=itortyp(itype(i))
8237 if (j.lt.nres-1) then
8238 itj1=itortyp(itype(j+1))
8242 itk=itortyp(itype(k))
8243 itk1=itortyp(itype(k+1))
8244 if (l.lt.nres-1) then
8245 itl1=itortyp(itype(l+1))
8250 s1=dip(4,jj,i)*dip(4,kk,k)
8252 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8253 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8254 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8255 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8256 call transpose2(EE(1,1,itk),auxmat(1,1))
8257 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8258 vv(1)=pizda(1,1)+pizda(2,2)
8259 vv(2)=pizda(2,1)-pizda(1,2)
8260 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8261 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8262 cd & "sum",-(s2+s3+s4)
8264 eello6_graph3=-(s1+s2+s3+s4)
8266 eello6_graph3=-(s2+s3+s4)
8269 C Derivatives in gamma(k-1)
8270 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8271 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8272 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8273 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8274 C Derivatives in gamma(l-1)
8275 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8276 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8277 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8278 vv(1)=pizda(1,1)+pizda(2,2)
8279 vv(2)=pizda(2,1)-pizda(1,2)
8280 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8281 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8282 C Cartesian derivatives.
8288 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8290 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8293 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8295 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8296 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8298 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8299 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8301 vv(1)=pizda(1,1)+pizda(2,2)
8302 vv(2)=pizda(2,1)-pizda(1,2)
8303 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8305 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8307 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8310 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8312 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8314 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8320 c----------------------------------------------------------------------------
8321 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8322 implicit real*8 (a-h,o-z)
8323 include 'DIMENSIONS'
8324 include 'COMMON.IOUNITS'
8325 include 'COMMON.CHAIN'
8326 include 'COMMON.DERIV'
8327 include 'COMMON.INTERACT'
8328 include 'COMMON.CONTACTS'
8329 include 'COMMON.TORSION'
8330 include 'COMMON.VAR'
8331 include 'COMMON.GEO'
8332 include 'COMMON.FFIELD'
8333 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8334 & auxvec1(2),auxmat1(2,2)
8336 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8338 C Parallel Antiparallel C
8344 C \ j|/k\| \ |/k\|l C
8349 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8351 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8352 C energy moment and not to the cluster cumulant.
8353 cd write (2,*) 'eello_graph4: wturn6',wturn6
8354 iti=itortyp(itype(i))
8355 itj=itortyp(itype(j))
8356 if (j.lt.nres-1) then
8357 itj1=itortyp(itype(j+1))
8361 itk=itortyp(itype(k))
8362 if (k.lt.nres-1) then
8363 itk1=itortyp(itype(k+1))
8367 itl=itortyp(itype(l))
8368 if (l.lt.nres-1) then
8369 itl1=itortyp(itype(l+1))
8373 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8374 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8375 cd & ' itl',itl,' itl1',itl1
8378 s1=dip(3,jj,i)*dip(3,kk,k)
8380 s1=dip(2,jj,j)*dip(2,kk,l)
8383 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8384 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8386 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8387 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8389 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8390 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8392 call transpose2(EUg(1,1,k),auxmat(1,1))
8393 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8394 vv(1)=pizda(1,1)-pizda(2,2)
8395 vv(2)=pizda(2,1)+pizda(1,2)
8396 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8397 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8399 eello6_graph4=-(s1+s2+s3+s4)
8401 eello6_graph4=-(s2+s3+s4)
8403 C Derivatives in gamma(i-1)
8407 s1=dipderg(2,jj,i)*dip(3,kk,k)
8409 s1=dipderg(4,jj,j)*dip(2,kk,l)
8412 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8414 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8415 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8417 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8418 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8420 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8421 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8422 cd write (2,*) 'turn6 derivatives'
8424 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8426 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8430 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8432 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8436 C Derivatives in gamma(k-1)
8439 s1=dip(3,jj,i)*dipderg(2,kk,k)
8441 s1=dip(2,jj,j)*dipderg(4,kk,l)
8444 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8445 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8447 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8448 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8450 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8451 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8453 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8454 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8455 vv(1)=pizda(1,1)-pizda(2,2)
8456 vv(2)=pizda(2,1)+pizda(1,2)
8457 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8458 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8460 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8462 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8466 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8468 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8471 C Derivatives in gamma(j-1) or gamma(l-1)
8472 if (l.eq.j+1 .and. l.gt.1) then
8473 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8474 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8475 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8476 vv(1)=pizda(1,1)-pizda(2,2)
8477 vv(2)=pizda(2,1)+pizda(1,2)
8478 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8479 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8480 else if (j.gt.1) then
8481 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8482 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8483 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8484 vv(1)=pizda(1,1)-pizda(2,2)
8485 vv(2)=pizda(2,1)+pizda(1,2)
8486 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8487 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8488 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8490 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8493 C Cartesian derivatives.
8500 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8502 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8506 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8508 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8512 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8514 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8516 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8517 & b1(1,itj1),auxvec(1))
8518 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8520 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8521 & b1(1,itl1),auxvec(1))
8522 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8524 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8526 vv(1)=pizda(1,1)-pizda(2,2)
8527 vv(2)=pizda(2,1)+pizda(1,2)
8528 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8530 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8532 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8535 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8538 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8541 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8543 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8545 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8549 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8551 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8554 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8556 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8564 c----------------------------------------------------------------------------
8565 double precision function eello_turn6(i,jj,kk)
8566 implicit real*8 (a-h,o-z)
8567 include 'DIMENSIONS'
8568 include 'COMMON.IOUNITS'
8569 include 'COMMON.CHAIN'
8570 include 'COMMON.DERIV'
8571 include 'COMMON.INTERACT'
8572 include 'COMMON.CONTACTS'
8573 include 'COMMON.TORSION'
8574 include 'COMMON.VAR'
8575 include 'COMMON.GEO'
8576 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8577 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8579 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8580 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8581 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8582 C the respective energy moment and not to the cluster cumulant.
8591 iti=itortyp(itype(i))
8592 itk=itortyp(itype(k))
8593 itk1=itortyp(itype(k+1))
8594 itl=itortyp(itype(l))
8595 itj=itortyp(itype(j))
8596 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8597 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8598 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8603 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8605 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8609 derx_turn(lll,kkk,iii)=0.0d0
8616 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8618 cd write (2,*) 'eello6_5',eello6_5
8620 call transpose2(AEA(1,1,1),auxmat(1,1))
8621 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8622 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8623 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8625 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8626 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8627 s2 = scalar2(b1(1,itk),vtemp1(1))
8629 call transpose2(AEA(1,1,2),atemp(1,1))
8630 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8631 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8632 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8634 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8635 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8636 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8638 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8639 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8640 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8641 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8642 ss13 = scalar2(b1(1,itk),vtemp4(1))
8643 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8645 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8651 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8652 C Derivatives in gamma(i+2)
8656 call transpose2(AEA(1,1,1),auxmatd(1,1))
8657 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8658 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8659 call transpose2(AEAderg(1,1,2),atempd(1,1))
8660 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8661 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8663 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8664 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8665 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8671 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8672 C Derivatives in gamma(i+3)
8674 call transpose2(AEA(1,1,1),auxmatd(1,1))
8675 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8676 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8677 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8679 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8680 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8681 s2d = scalar2(b1(1,itk),vtemp1d(1))
8683 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8684 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8686 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8688 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8689 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8690 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8698 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8699 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8701 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8702 & -0.5d0*ekont*(s2d+s12d)
8704 C Derivatives in gamma(i+4)
8705 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8706 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8707 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8709 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8710 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8711 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8719 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8721 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8723 C Derivatives in gamma(i+5)
8725 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8726 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8727 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8729 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8730 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8731 s2d = scalar2(b1(1,itk),vtemp1d(1))
8733 call transpose2(AEA(1,1,2),atempd(1,1))
8734 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8735 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8737 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8738 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8740 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8741 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8742 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8750 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8751 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8753 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8754 & -0.5d0*ekont*(s2d+s12d)
8756 C Cartesian derivatives
8761 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8762 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8763 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8765 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8766 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8768 s2d = scalar2(b1(1,itk),vtemp1d(1))
8770 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8771 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8772 s8d = -(atempd(1,1)+atempd(2,2))*
8773 & scalar2(cc(1,1,itl),vtemp2(1))
8775 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8777 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8778 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8785 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8788 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8792 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8793 & - 0.5d0*(s8d+s12d)
8795 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8804 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8806 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8807 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8808 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8809 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8810 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8812 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8813 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8814 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8818 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8819 cd & 16*eel_turn6_num
8821 if (j.lt.nres-1) then
8828 if (l.lt.nres-1) then
8836 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8837 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8838 cgrad ghalf=0.5d0*ggg1(ll)
8840 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8841 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8842 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8843 & +ekont*derx_turn(ll,2,1)
8844 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8845 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8846 & +ekont*derx_turn(ll,4,1)
8847 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8848 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8849 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8850 cgrad ghalf=0.5d0*ggg2(ll)
8852 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8853 & +ekont*derx_turn(ll,2,2)
8854 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8855 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8856 & +ekont*derx_turn(ll,4,2)
8857 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8858 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8859 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8864 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8869 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8875 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8880 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8884 cd write (2,*) iii,g_corr6_loc(iii)
8886 eello_turn6=ekont*eel_turn6
8887 cd write (2,*) 'ekont',ekont
8888 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8892 C-----------------------------------------------------------------------------
8893 double precision function scalar(u,v)
8894 !DIR$ INLINEALWAYS scalar
8896 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8899 double precision u(3),v(3)
8900 cd double precision sc
8908 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8911 crc-------------------------------------------------
8912 SUBROUTINE MATVEC2(A1,V1,V2)
8913 !DIR$ INLINEALWAYS MATVEC2
8915 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8917 implicit real*8 (a-h,o-z)
8918 include 'DIMENSIONS'
8919 DIMENSION A1(2,2),V1(2),V2(2)
8923 c 3 VI=VI+A1(I,K)*V1(K)
8927 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8928 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8933 C---------------------------------------
8934 SUBROUTINE MATMAT2(A1,A2,A3)
8936 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8938 implicit real*8 (a-h,o-z)
8939 include 'DIMENSIONS'
8940 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8941 c DIMENSION AI3(2,2)
8945 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8951 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8952 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8953 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8954 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8962 c-------------------------------------------------------------------------
8963 double precision function scalar2(u,v)
8964 !DIR$ INLINEALWAYS scalar2
8966 double precision u(2),v(2)
8969 scalar2=u(1)*v(1)+u(2)*v(2)
8973 C-----------------------------------------------------------------------------
8975 subroutine transpose2(a,at)
8976 !DIR$ INLINEALWAYS transpose2
8978 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8981 double precision a(2,2),at(2,2)
8988 c--------------------------------------------------------------------------
8989 subroutine transpose(n,a,at)
8992 double precision a(n,n),at(n,n)
9000 C---------------------------------------------------------------------------
9001 subroutine prodmat3(a1,a2,kk,transp,prod)
9002 !DIR$ INLINEALWAYS prodmat3
9004 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9008 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9010 crc double precision auxmat(2,2),prod_(2,2)
9013 crc call transpose2(kk(1,1),auxmat(1,1))
9014 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9015 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9017 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9018 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9019 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9020 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9021 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9022 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9023 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9024 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9027 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9028 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9030 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9031 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9032 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9033 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9034 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9035 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9036 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9037 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9040 c call transpose2(a2(1,1),a2t(1,1))
9043 crc print *,((prod_(i,j),i=1,2),j=1,2)
9044 crc print *,((prod(i,j),i=1,2),j=1,2)