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)
4088 cd write (iout,*) "eij",eij
4091 C Calculate the distance between the two points and its difference from the
4095 C Get the force constant corresponding to this distance.
4097 C Calculate the contribution to energy.
4098 ehpb=ehpb+waga*rdis*rdis
4100 C Evaluate gradient.
4103 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4104 cd & ' waga=',waga,' fac=',fac
4106 ggg(j)=fac*(c(j,jj)-c(j,ii))
4108 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4109 C If this is a SC-SC distance, we need to calculate the contributions to the
4110 C Cartesian gradient in the SC vectors (ghpbx).
4113 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4114 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4117 cgrad do j=iii,jjj-1
4119 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4123 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4124 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4131 C--------------------------------------------------------------------------
4132 subroutine ssbond_ene(i,j,eij)
4134 C Calculate the distance and angle dependent SS-bond potential energy
4135 C using a free-energy function derived based on RHF/6-31G** ab initio
4136 C calculations of diethyl disulfide.
4138 C A. Liwo and U. Kozlowska, 11/24/03
4140 implicit real*8 (a-h,o-z)
4141 include 'DIMENSIONS'
4142 include 'COMMON.SBRIDGE'
4143 include 'COMMON.CHAIN'
4144 include 'COMMON.DERIV'
4145 include 'COMMON.LOCAL'
4146 include 'COMMON.INTERACT'
4147 include 'COMMON.VAR'
4148 include 'COMMON.IOUNITS'
4149 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4150 itypi=iabs(itype(i))
4154 dxi=dc_norm(1,nres+i)
4155 dyi=dc_norm(2,nres+i)
4156 dzi=dc_norm(3,nres+i)
4157 c dsci_inv=dsc_inv(itypi)
4158 dsci_inv=vbld_inv(nres+i)
4159 itypj=iabs(itype(j))
4160 c dscj_inv=dsc_inv(itypj)
4161 dscj_inv=vbld_inv(nres+j)
4165 dxj=dc_norm(1,nres+j)
4166 dyj=dc_norm(2,nres+j)
4167 dzj=dc_norm(3,nres+j)
4168 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4173 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4174 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4175 om12=dxi*dxj+dyi*dyj+dzi*dzj
4177 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4178 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4184 deltat12=om2-om1+2.0d0
4186 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4187 & +akct*deltad*deltat12
4188 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4189 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4190 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4191 c & " deltat12",deltat12," eij",eij
4192 ed=2*akcm*deltad+akct*deltat12
4194 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4195 eom1=-2*akth*deltat1-pom1-om2*pom2
4196 eom2= 2*akth*deltat2+pom1-om1*pom2
4199 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4200 ghpbx(k,i)=ghpbx(k,i)-ggk
4201 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4202 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4203 ghpbx(k,j)=ghpbx(k,j)+ggk
4204 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4205 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4206 ghpbc(k,i)=ghpbc(k,i)-ggk
4207 ghpbc(k,j)=ghpbc(k,j)+ggk
4210 C Calculate the components of the gradient in DC and X
4214 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4219 C--------------------------------------------------------------------------
4220 subroutine ebond(estr)
4222 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4224 implicit real*8 (a-h,o-z)
4225 include 'DIMENSIONS'
4226 include 'COMMON.LOCAL'
4227 include 'COMMON.GEO'
4228 include 'COMMON.INTERACT'
4229 include 'COMMON.DERIV'
4230 include 'COMMON.VAR'
4231 include 'COMMON.CHAIN'
4232 include 'COMMON.IOUNITS'
4233 include 'COMMON.NAMES'
4234 include 'COMMON.FFIELD'
4235 include 'COMMON.CONTROL'
4236 include 'COMMON.SETUP'
4237 double precision u(3),ud(3)
4240 do i=ibondp_start,ibondp_end
4241 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4242 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4244 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4245 & *dc(j,i-1)/vbld(i)
4247 if (energy_dec) write(iout,*)
4248 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4250 diff = vbld(i)-vbldp0
4251 if (energy_dec) write (iout,*)
4252 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4255 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4257 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4260 estr=0.5d0*AKP*estr+estr1
4262 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4264 do i=ibond_start,ibond_end
4266 if (iti.ne.10 .and. iti.ne.ntyp1) then
4269 diff=vbld(i+nres)-vbldsc0(1,iti)
4270 if (energy_dec) write (iout,*)
4271 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4272 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4273 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4275 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4279 diff=vbld(i+nres)-vbldsc0(j,iti)
4280 ud(j)=aksc(j,iti)*diff
4281 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4295 uprod2=uprod2*u(k)*u(k)
4299 usumsqder=usumsqder+ud(j)*uprod2
4301 estr=estr+uprod/usum
4303 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4311 C--------------------------------------------------------------------------
4312 subroutine ebend(etheta)
4314 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4315 C angles gamma and its derivatives in consecutive thetas and gammas.
4317 implicit real*8 (a-h,o-z)
4318 include 'DIMENSIONS'
4319 include 'COMMON.LOCAL'
4320 include 'COMMON.GEO'
4321 include 'COMMON.INTERACT'
4322 include 'COMMON.DERIV'
4323 include 'COMMON.VAR'
4324 include 'COMMON.CHAIN'
4325 include 'COMMON.IOUNITS'
4326 include 'COMMON.NAMES'
4327 include 'COMMON.FFIELD'
4328 include 'COMMON.CONTROL'
4329 common /calcthet/ term1,term2,termm,diffak,ratak,
4330 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4331 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4332 double precision y(2),z(2)
4334 c time11=dexp(-2*time)
4337 c write (*,'(a,i2)') 'EBEND ICG=',icg
4338 do i=ithet_start,ithet_end
4339 if (itype(i-1).eq.ntyp1) cycle
4340 C Zero the energy function and its derivative at 0 or pi.
4341 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4343 ichir1=isign(1,itype(i-2))
4344 ichir2=isign(1,itype(i))
4345 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4346 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4347 if (itype(i-1).eq.10) then
4348 itype1=isign(10,itype(i-2))
4349 ichir11=isign(1,itype(i-2))
4350 ichir12=isign(1,itype(i-2))
4351 itype2=isign(10,itype(i))
4352 ichir21=isign(1,itype(i))
4353 ichir22=isign(1,itype(i))
4356 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4359 if (phii.ne.phii) phii=150.0
4369 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4372 if (phii1.ne.phii1) phii1=150.0
4384 C Calculate the "mean" value of theta from the part of the distribution
4385 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4386 C In following comments this theta will be referred to as t_c.
4387 thet_pred_mean=0.0d0
4389 athetk=athet(k,it,ichir1,ichir2)
4390 bthetk=bthet(k,it,ichir1,ichir2)
4392 athetk=athet(k,itype1,ichir11,ichir12)
4393 bthetk=bthet(k,itype2,ichir21,ichir22)
4395 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4397 dthett=thet_pred_mean*ssd
4398 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4399 C Derivatives of the "mean" values in gamma1 and gamma2.
4400 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4401 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4402 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4403 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4405 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4406 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4407 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4408 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4410 if (theta(i).gt.pi-delta) then
4411 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4413 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4414 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4415 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4417 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4419 else if (theta(i).lt.delta) then
4420 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4421 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4422 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4424 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4425 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4428 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4431 etheta=etheta+ethetai
4432 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4434 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4435 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4436 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4438 C Ufff.... We've done all this!!!
4441 C---------------------------------------------------------------------------
4442 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4444 implicit real*8 (a-h,o-z)
4445 include 'DIMENSIONS'
4446 include 'COMMON.LOCAL'
4447 include 'COMMON.IOUNITS'
4448 common /calcthet/ term1,term2,termm,diffak,ratak,
4449 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4450 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4451 C Calculate the contributions to both Gaussian lobes.
4452 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4453 C The "polynomial part" of the "standard deviation" of this part of
4457 sig=sig*thet_pred_mean+polthet(j,it)
4459 C Derivative of the "interior part" of the "standard deviation of the"
4460 C gamma-dependent Gaussian lobe in t_c.
4461 sigtc=3*polthet(3,it)
4463 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4466 C Set the parameters of both Gaussian lobes of the distribution.
4467 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4468 fac=sig*sig+sigc0(it)
4471 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4472 sigsqtc=-4.0D0*sigcsq*sigtc
4473 c print *,i,sig,sigtc,sigsqtc
4474 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4475 sigtc=-sigtc/(fac*fac)
4476 C Following variable is sigma(t_c)**(-2)
4477 sigcsq=sigcsq*sigcsq
4479 sig0inv=1.0D0/sig0i**2
4480 delthec=thetai-thet_pred_mean
4481 delthe0=thetai-theta0i
4482 term1=-0.5D0*sigcsq*delthec*delthec
4483 term2=-0.5D0*sig0inv*delthe0*delthe0
4484 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4485 C NaNs in taking the logarithm. We extract the largest exponent which is added
4486 C to the energy (this being the log of the distribution) at the end of energy
4487 C term evaluation for this virtual-bond angle.
4488 if (term1.gt.term2) then
4490 term2=dexp(term2-termm)
4494 term1=dexp(term1-termm)
4497 C The ratio between the gamma-independent and gamma-dependent lobes of
4498 C the distribution is a Gaussian function of thet_pred_mean too.
4499 diffak=gthet(2,it)-thet_pred_mean
4500 ratak=diffak/gthet(3,it)**2
4501 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4502 C Let's differentiate it in thet_pred_mean NOW.
4504 C Now put together the distribution terms to make complete distribution.
4505 termexp=term1+ak*term2
4506 termpre=sigc+ak*sig0i
4507 C Contribution of the bending energy from this theta is just the -log of
4508 C the sum of the contributions from the two lobes and the pre-exponential
4509 C factor. Simple enough, isn't it?
4510 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4511 C NOW the derivatives!!!
4512 C 6/6/97 Take into account the deformation.
4513 E_theta=(delthec*sigcsq*term1
4514 & +ak*delthe0*sig0inv*term2)/termexp
4515 E_tc=((sigtc+aktc*sig0i)/termpre
4516 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4517 & aktc*term2)/termexp)
4520 c-----------------------------------------------------------------------------
4521 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4522 implicit real*8 (a-h,o-z)
4523 include 'DIMENSIONS'
4524 include 'COMMON.LOCAL'
4525 include 'COMMON.IOUNITS'
4526 common /calcthet/ term1,term2,termm,diffak,ratak,
4527 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4528 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4529 delthec=thetai-thet_pred_mean
4530 delthe0=thetai-theta0i
4531 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4532 t3 = thetai-thet_pred_mean
4536 t14 = t12+t6*sigsqtc
4538 t21 = thetai-theta0i
4544 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4545 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4546 & *(-t12*t9-ak*sig0inv*t27)
4550 C--------------------------------------------------------------------------
4551 subroutine ebend(etheta)
4553 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4554 C angles gamma and its derivatives in consecutive thetas and gammas.
4555 C ab initio-derived potentials from
4556 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4558 implicit real*8 (a-h,o-z)
4559 include 'DIMENSIONS'
4560 include 'COMMON.LOCAL'
4561 include 'COMMON.GEO'
4562 include 'COMMON.INTERACT'
4563 include 'COMMON.DERIV'
4564 include 'COMMON.VAR'
4565 include 'COMMON.CHAIN'
4566 include 'COMMON.IOUNITS'
4567 include 'COMMON.NAMES'
4568 include 'COMMON.FFIELD'
4569 include 'COMMON.CONTROL'
4570 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4571 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4572 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4573 & sinph1ph2(maxdouble,maxdouble)
4574 logical lprn /.false./, lprn1 /.false./
4576 do i=ithet_start,ithet_end
4577 if (itype(i-1).eq.ntyp1) cycle
4578 if (iabs(itype(i+1)).eq.20) iblock=2
4579 if (iabs(itype(i+1)).ne.20) iblock=1
4583 theti2=0.5d0*theta(i)
4584 ityp2=ithetyp((itype(i-1)))
4586 coskt(k)=dcos(k*theti2)
4587 sinkt(k)=dsin(k*theti2)
4589 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4592 if (phii.ne.phii) phii=150.0
4596 ityp1=ithetyp((itype(i-2)))
4597 C propagation of chirality for glycine type
4599 cosph1(k)=dcos(k*phii)
4600 sinph1(k)=dsin(k*phii)
4610 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4613 if (phii1.ne.phii1) phii1=150.0
4618 ityp3=ithetyp((itype(i)))
4620 cosph2(k)=dcos(k*phii1)
4621 sinph2(k)=dsin(k*phii1)
4631 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4634 ccl=cosph1(l)*cosph2(k-l)
4635 ssl=sinph1(l)*sinph2(k-l)
4636 scl=sinph1(l)*cosph2(k-l)
4637 csl=cosph1(l)*sinph2(k-l)
4638 cosph1ph2(l,k)=ccl-ssl
4639 cosph1ph2(k,l)=ccl+ssl
4640 sinph1ph2(l,k)=scl+csl
4641 sinph1ph2(k,l)=scl-csl
4645 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4646 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4647 write (iout,*) "coskt and sinkt"
4649 write (iout,*) k,coskt(k),sinkt(k)
4653 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4654 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4657 & write (iout,*) "k",k,"
4658 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4659 & " ethetai",ethetai
4662 write (iout,*) "cosph and sinph"
4664 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4666 write (iout,*) "cosph1ph2 and sinph2ph2"
4669 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4670 & sinph1ph2(l,k),sinph1ph2(k,l)
4673 write(iout,*) "ethetai",ethetai
4677 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4678 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4679 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4680 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4681 ethetai=ethetai+sinkt(m)*aux
4682 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4683 dephii=dephii+k*sinkt(m)*(
4684 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4685 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4686 dephii1=dephii1+k*sinkt(m)*(
4687 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4688 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4690 & write (iout,*) "m",m," k",k," bbthet",
4691 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4692 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4693 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4694 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4698 & write(iout,*) "ethetai",ethetai
4702 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4703 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4704 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4705 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4706 ethetai=ethetai+sinkt(m)*aux
4707 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4708 dephii=dephii+l*sinkt(m)*(
4709 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4710 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4711 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4712 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4713 dephii1=dephii1+(k-l)*sinkt(m)*(
4714 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4715 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4716 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4717 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4719 write (iout,*) "m",m," k",k," l",l," ffthet",
4720 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4721 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4722 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4723 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4724 & " ethetai",ethetai
4725 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4726 & cosph1ph2(k,l)*sinkt(m),
4727 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4735 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4736 & i,theta(i)*rad2deg,phii*rad2deg,
4737 & phii1*rad2deg,ethetai
4739 etheta=etheta+ethetai
4740 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4741 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4742 gloc(nphi+i-2,icg)=wang*dethetai
4748 c-----------------------------------------------------------------------------
4749 subroutine esc(escloc)
4750 C Calculate the local energy of a side chain and its derivatives in the
4751 C corresponding virtual-bond valence angles THETA and the spherical angles
4753 implicit real*8 (a-h,o-z)
4754 include 'DIMENSIONS'
4755 include 'COMMON.GEO'
4756 include 'COMMON.LOCAL'
4757 include 'COMMON.VAR'
4758 include 'COMMON.INTERACT'
4759 include 'COMMON.DERIV'
4760 include 'COMMON.CHAIN'
4761 include 'COMMON.IOUNITS'
4762 include 'COMMON.NAMES'
4763 include 'COMMON.FFIELD'
4764 include 'COMMON.CONTROL'
4765 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4766 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4767 common /sccalc/ time11,time12,time112,theti,it,nlobit
4770 c write (iout,'(a)') 'ESC'
4771 do i=loc_start,loc_end
4773 if (it.eq.ntyp1) cycle
4774 if (it.eq.10) goto 1
4775 nlobit=nlob(iabs(it))
4776 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4777 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4778 theti=theta(i+1)-pipol
4783 if (x(2).gt.pi-delta) then
4787 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4789 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4790 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4792 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4793 & ddersc0(1),dersc(1))
4794 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4795 & ddersc0(3),dersc(3))
4797 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4799 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4800 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4801 & dersc0(2),esclocbi,dersc02)
4802 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4804 call splinthet(x(2),0.5d0*delta,ss,ssd)
4809 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4811 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4812 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4814 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4816 c write (iout,*) escloci
4817 else if (x(2).lt.delta) then
4821 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4823 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4824 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4826 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4827 & ddersc0(1),dersc(1))
4828 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4829 & ddersc0(3),dersc(3))
4831 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4833 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4834 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4835 & dersc0(2),esclocbi,dersc02)
4836 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4841 call splinthet(x(2),0.5d0*delta,ss,ssd)
4843 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4845 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4846 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4848 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4849 c write (iout,*) escloci
4851 call enesc(x,escloci,dersc,ddummy,.false.)
4854 escloc=escloc+escloci
4855 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4856 & 'escloc',i,escloci
4857 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4859 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4861 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4862 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4867 C---------------------------------------------------------------------------
4868 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4869 implicit real*8 (a-h,o-z)
4870 include 'DIMENSIONS'
4871 include 'COMMON.GEO'
4872 include 'COMMON.LOCAL'
4873 include 'COMMON.IOUNITS'
4874 common /sccalc/ time11,time12,time112,theti,it,nlobit
4875 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4876 double precision contr(maxlob,-1:1)
4878 c write (iout,*) 'it=',it,' nlobit=',nlobit
4882 if (mixed) ddersc(j)=0.0d0
4886 C Because of periodicity of the dependence of the SC energy in omega we have
4887 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4888 C To avoid underflows, first compute & store the exponents.
4896 z(k)=x(k)-censc(k,j,it)
4901 Axk=Axk+gaussc(l,k,j,it)*z(l)
4907 expfac=expfac+Ax(k,j,iii)*z(k)
4915 C As in the case of ebend, we want to avoid underflows in exponentiation and
4916 C subsequent NaNs and INFs in energy calculation.
4917 C Find the largest exponent
4921 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4925 cd print *,'it=',it,' emin=',emin
4927 C Compute the contribution to SC energy and derivatives
4932 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
4933 if(adexp.ne.adexp) adexp=1.0
4936 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4938 cd print *,'j=',j,' expfac=',expfac
4939 escloc_i=escloc_i+expfac
4941 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4945 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4946 & +gaussc(k,2,j,it))*expfac
4953 dersc(1)=dersc(1)/cos(theti)**2
4954 ddersc(1)=ddersc(1)/cos(theti)**2
4957 escloci=-(dlog(escloc_i)-emin)
4959 dersc(j)=dersc(j)/escloc_i
4963 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4968 C------------------------------------------------------------------------------
4969 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4970 implicit real*8 (a-h,o-z)
4971 include 'DIMENSIONS'
4972 include 'COMMON.GEO'
4973 include 'COMMON.LOCAL'
4974 include 'COMMON.IOUNITS'
4975 common /sccalc/ time11,time12,time112,theti,it,nlobit
4976 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4977 double precision contr(maxlob)
4988 z(k)=x(k)-censc(k,j,it)
4994 Axk=Axk+gaussc(l,k,j,it)*z(l)
5000 expfac=expfac+Ax(k,j)*z(k)
5005 C As in the case of ebend, we want to avoid underflows in exponentiation and
5006 C subsequent NaNs and INFs in energy calculation.
5007 C Find the largest exponent
5010 if (emin.gt.contr(j)) emin=contr(j)
5014 C Compute the contribution to SC energy and derivatives
5018 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5019 escloc_i=escloc_i+expfac
5021 dersc(k)=dersc(k)+Ax(k,j)*expfac
5023 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5024 & +gaussc(1,2,j,it))*expfac
5028 dersc(1)=dersc(1)/cos(theti)**2
5029 dersc12=dersc12/cos(theti)**2
5030 escloci=-(dlog(escloc_i)-emin)
5032 dersc(j)=dersc(j)/escloc_i
5034 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5038 c----------------------------------------------------------------------------------
5039 subroutine esc(escloc)
5040 C Calculate the local energy of a side chain and its derivatives in the
5041 C corresponding virtual-bond valence angles THETA and the spherical angles
5042 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5043 C added by Urszula Kozlowska. 07/11/2007
5045 implicit real*8 (a-h,o-z)
5046 include 'DIMENSIONS'
5047 include 'COMMON.GEO'
5048 include 'COMMON.LOCAL'
5049 include 'COMMON.VAR'
5050 include 'COMMON.SCROT'
5051 include 'COMMON.INTERACT'
5052 include 'COMMON.DERIV'
5053 include 'COMMON.CHAIN'
5054 include 'COMMON.IOUNITS'
5055 include 'COMMON.NAMES'
5056 include 'COMMON.FFIELD'
5057 include 'COMMON.CONTROL'
5058 include 'COMMON.VECTORS'
5059 double precision x_prime(3),y_prime(3),z_prime(3)
5060 & , sumene,dsc_i,dp2_i,x(65),
5061 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5062 & de_dxx,de_dyy,de_dzz,de_dt
5063 double precision s1_t,s1_6_t,s2_t,s2_6_t
5065 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5066 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5067 & dt_dCi(3),dt_dCi1(3)
5068 common /sccalc/ time11,time12,time112,theti,it,nlobit
5071 do i=loc_start,loc_end
5072 if (itype(i).eq.ntyp1) cycle
5073 costtab(i+1) =dcos(theta(i+1))
5074 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5075 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5076 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5077 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5078 cosfac=dsqrt(cosfac2)
5079 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5080 sinfac=dsqrt(sinfac2)
5082 if (it.eq.10) goto 1
5084 C Compute the axes of tghe local cartesian coordinates system; store in
5085 c x_prime, y_prime and z_prime
5092 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5093 C & dc_norm(3,i+nres)
5095 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5096 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5099 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5102 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5103 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5104 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5105 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5106 c & " xy",scalar(x_prime(1),y_prime(1)),
5107 c & " xz",scalar(x_prime(1),z_prime(1)),
5108 c & " yy",scalar(y_prime(1),y_prime(1)),
5109 c & " yz",scalar(y_prime(1),z_prime(1)),
5110 c & " zz",scalar(z_prime(1),z_prime(1))
5112 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5113 C to local coordinate system. Store in xx, yy, zz.
5119 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5120 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5121 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5128 C Compute the energy of the ith side cbain
5130 c write (2,*) "xx",xx," yy",yy," zz",zz
5133 x(j) = sc_parmin(j,it)
5136 Cc diagnostics - remove later
5138 yy1 = dsin(alph(2))*dcos(omeg(2))
5139 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5140 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5141 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5143 C," --- ", xx_w,yy_w,zz_w
5146 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5147 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5149 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5150 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5152 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5153 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5154 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5155 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5156 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5158 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5159 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5160 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5161 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5162 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5164 dsc_i = 0.743d0+x(61)
5166 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5167 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5168 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5169 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5170 s1=(1+x(63))/(0.1d0 + dscp1)
5171 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5172 s2=(1+x(65))/(0.1d0 + dscp2)
5173 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5174 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5175 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5176 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5178 c & dscp1,dscp2,sumene
5179 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5180 escloc = escloc + sumene
5181 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5186 C This section to check the numerical derivatives of the energy of ith side
5187 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5188 C #define DEBUG in the code to turn it on.
5190 write (2,*) "sumene =",sumene
5194 write (2,*) xx,yy,zz
5195 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5196 de_dxx_num=(sumenep-sumene)/aincr
5198 write (2,*) "xx+ sumene from enesc=",sumenep
5201 write (2,*) xx,yy,zz
5202 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5203 de_dyy_num=(sumenep-sumene)/aincr
5205 write (2,*) "yy+ sumene from enesc=",sumenep
5208 write (2,*) xx,yy,zz
5209 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5210 de_dzz_num=(sumenep-sumene)/aincr
5212 write (2,*) "zz+ sumene from enesc=",sumenep
5213 costsave=cost2tab(i+1)
5214 sintsave=sint2tab(i+1)
5215 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5216 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5217 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5218 de_dt_num=(sumenep-sumene)/aincr
5219 write (2,*) " t+ sumene from enesc=",sumenep
5220 cost2tab(i+1)=costsave
5221 sint2tab(i+1)=sintsave
5222 C End of diagnostics section.
5225 C Compute the gradient of esc
5227 c zz=zz*dsign(1.0,dfloat(itype(i)))
5228 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5229 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5230 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5231 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5232 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5233 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5234 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5235 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5236 pom1=(sumene3*sint2tab(i+1)+sumene1)
5237 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5238 pom2=(sumene4*cost2tab(i+1)+sumene2)
5239 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5240 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5241 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5242 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5244 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5245 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5246 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5248 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5249 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5250 & +(pom1+pom2)*pom_dx
5252 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5255 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5256 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5257 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5259 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5260 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5261 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5262 & +x(59)*zz**2 +x(60)*xx*zz
5263 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5264 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5265 & +(pom1-pom2)*pom_dy
5267 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5270 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5271 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5272 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5273 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5274 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5275 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5276 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5277 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5279 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5282 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5283 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5284 & +pom1*pom_dt1+pom2*pom_dt2
5286 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5291 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5292 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5293 cosfac2xx=cosfac2*xx
5294 sinfac2yy=sinfac2*yy
5296 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5298 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5300 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5301 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5302 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5303 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5304 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5305 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5306 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5307 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5308 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5309 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5313 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5314 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5315 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5316 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5319 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5320 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5321 dZZ_XYZ(k)=vbld_inv(i+nres)*
5322 & (z_prime(k)-zz*dC_norm(k,i+nres))
5324 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5325 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5329 dXX_Ctab(k,i)=dXX_Ci(k)
5330 dXX_C1tab(k,i)=dXX_Ci1(k)
5331 dYY_Ctab(k,i)=dYY_Ci(k)
5332 dYY_C1tab(k,i)=dYY_Ci1(k)
5333 dZZ_Ctab(k,i)=dZZ_Ci(k)
5334 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5335 dXX_XYZtab(k,i)=dXX_XYZ(k)
5336 dYY_XYZtab(k,i)=dYY_XYZ(k)
5337 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5341 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5342 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5343 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5344 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5345 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5347 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5348 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5349 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5350 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5351 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5352 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5353 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5354 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5356 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5357 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5359 C to check gradient call subroutine check_grad
5365 c------------------------------------------------------------------------------
5366 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5368 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5369 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5370 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5371 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5373 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5374 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5376 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5377 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5378 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5379 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5380 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5382 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5383 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5384 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5385 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5386 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5388 dsc_i = 0.743d0+x(61)
5390 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5391 & *(xx*cost2+yy*sint2))
5392 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5393 & *(xx*cost2-yy*sint2))
5394 s1=(1+x(63))/(0.1d0 + dscp1)
5395 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5396 s2=(1+x(65))/(0.1d0 + dscp2)
5397 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5398 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5399 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5404 c------------------------------------------------------------------------------
5405 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5407 C This procedure calculates two-body contact function g(rij) and its derivative:
5410 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5413 C where x=(rij-r0ij)/delta
5415 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5418 double precision rij,r0ij,eps0ij,fcont,fprimcont
5419 double precision x,x2,x4,delta
5423 if (x.lt.-1.0D0) then
5426 else if (x.le.1.0D0) then
5429 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5430 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5437 c------------------------------------------------------------------------------
5438 subroutine splinthet(theti,delta,ss,ssder)
5439 implicit real*8 (a-h,o-z)
5440 include 'DIMENSIONS'
5441 include 'COMMON.VAR'
5442 include 'COMMON.GEO'
5445 if (theti.gt.pipol) then
5446 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5448 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5453 c------------------------------------------------------------------------------
5454 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5456 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5457 double precision ksi,ksi2,ksi3,a1,a2,a3
5458 a1=fprim0*delta/(f1-f0)
5464 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5465 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5468 c------------------------------------------------------------------------------
5469 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5471 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5472 double precision ksi,ksi2,ksi3,a1,a2,a3
5477 a2=3*(f1x-f0x)-2*fprim0x*delta
5478 a3=fprim0x*delta-2*(f1x-f0x)
5479 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5482 C-----------------------------------------------------------------------------
5484 C-----------------------------------------------------------------------------
5485 subroutine etor(etors,edihcnstr)
5486 implicit real*8 (a-h,o-z)
5487 include 'DIMENSIONS'
5488 include 'COMMON.VAR'
5489 include 'COMMON.GEO'
5490 include 'COMMON.LOCAL'
5491 include 'COMMON.TORSION'
5492 include 'COMMON.INTERACT'
5493 include 'COMMON.DERIV'
5494 include 'COMMON.CHAIN'
5495 include 'COMMON.NAMES'
5496 include 'COMMON.IOUNITS'
5497 include 'COMMON.FFIELD'
5498 include 'COMMON.TORCNSTR'
5499 include 'COMMON.CONTROL'
5501 C Set lprn=.true. for debugging
5505 do i=iphi_start,iphi_end
5507 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5508 & .or. itype(i).eq.ntyp1) cycle
5509 itori=itortyp(itype(i-2))
5510 itori1=itortyp(itype(i-1))
5513 C Proline-Proline pair is a special case...
5514 if (itori.eq.3 .and. itori1.eq.3) then
5515 if (phii.gt.-dwapi3) then
5517 fac=1.0D0/(1.0D0-cosphi)
5518 etorsi=v1(1,3,3)*fac
5519 etorsi=etorsi+etorsi
5520 etors=etors+etorsi-v1(1,3,3)
5521 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5522 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5525 v1ij=v1(j+1,itori,itori1)
5526 v2ij=v2(j+1,itori,itori1)
5529 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5530 if (energy_dec) etors_ii=etors_ii+
5531 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5532 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5536 v1ij=v1(j,itori,itori1)
5537 v2ij=v2(j,itori,itori1)
5540 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5541 if (energy_dec) etors_ii=etors_ii+
5542 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5543 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5546 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5549 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5550 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5551 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5552 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5553 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5555 ! 6/20/98 - dihedral angle constraints
5558 itori=idih_constr(i)
5561 if (difi.gt.drange(i)) then
5563 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5564 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5565 else if (difi.lt.-drange(i)) then
5567 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5568 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5570 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5571 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5573 ! write (iout,*) 'edihcnstr',edihcnstr
5576 c------------------------------------------------------------------------------
5577 subroutine etor_d(etors_d)
5581 c----------------------------------------------------------------------------
5583 subroutine etor(etors,edihcnstr)
5584 implicit real*8 (a-h,o-z)
5585 include 'DIMENSIONS'
5586 include 'COMMON.VAR'
5587 include 'COMMON.GEO'
5588 include 'COMMON.LOCAL'
5589 include 'COMMON.TORSION'
5590 include 'COMMON.INTERACT'
5591 include 'COMMON.DERIV'
5592 include 'COMMON.CHAIN'
5593 include 'COMMON.NAMES'
5594 include 'COMMON.IOUNITS'
5595 include 'COMMON.FFIELD'
5596 include 'COMMON.TORCNSTR'
5597 include 'COMMON.CONTROL'
5599 C Set lprn=.true. for debugging
5603 do i=iphi_start,iphi_end
5604 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5605 & .or. itype(i).eq.ntyp1) cycle
5607 if (iabs(itype(i)).eq.20) then
5612 itori=itortyp(itype(i-2))
5613 itori1=itortyp(itype(i-1))
5616 C Regular cosine and sine terms
5617 do j=1,nterm(itori,itori1,iblock)
5618 v1ij=v1(j,itori,itori1,iblock)
5619 v2ij=v2(j,itori,itori1,iblock)
5622 etors=etors+v1ij*cosphi+v2ij*sinphi
5623 if (energy_dec) etors_ii=etors_ii+
5624 & v1ij*cosphi+v2ij*sinphi
5625 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5629 C E = SUM ----------------------------------- - v1
5630 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5632 cosphi=dcos(0.5d0*phii)
5633 sinphi=dsin(0.5d0*phii)
5634 do j=1,nlor(itori,itori1,iblock)
5635 vl1ij=vlor1(j,itori,itori1)
5636 vl2ij=vlor2(j,itori,itori1)
5637 vl3ij=vlor3(j,itori,itori1)
5638 pom=vl2ij*cosphi+vl3ij*sinphi
5639 pom1=1.0d0/(pom*pom+1.0d0)
5640 etors=etors+vl1ij*pom1
5641 if (energy_dec) etors_ii=etors_ii+
5644 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5646 C Subtract the constant term
5647 etors=etors-v0(itori,itori1,iblock)
5648 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5649 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5651 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5652 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5653 & (v1(j,itori,itori1,iblock),j=1,6),
5654 & (v2(j,itori,itori1,iblock),j=1,6)
5655 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5656 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5658 ! 6/20/98 - dihedral angle constraints
5660 c do i=1,ndih_constr
5661 do i=idihconstr_start,idihconstr_end
5662 itori=idih_constr(i)
5664 difi=pinorm(phii-phi0(i))
5665 if (difi.gt.drange(i)) then
5667 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5668 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5669 else if (difi.lt.-drange(i)) then
5671 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5672 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5676 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5677 cd & rad2deg*phi0(i), rad2deg*drange(i),
5678 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5680 cd write (iout,*) 'edihcnstr',edihcnstr
5683 c----------------------------------------------------------------------------
5684 subroutine etor_d(etors_d)
5685 C 6/23/01 Compute double torsional energy
5686 implicit real*8 (a-h,o-z)
5687 include 'DIMENSIONS'
5688 include 'COMMON.VAR'
5689 include 'COMMON.GEO'
5690 include 'COMMON.LOCAL'
5691 include 'COMMON.TORSION'
5692 include 'COMMON.INTERACT'
5693 include 'COMMON.DERIV'
5694 include 'COMMON.CHAIN'
5695 include 'COMMON.NAMES'
5696 include 'COMMON.IOUNITS'
5697 include 'COMMON.FFIELD'
5698 include 'COMMON.TORCNSTR'
5700 C Set lprn=.true. for debugging
5704 c write(iout,*) "a tu??"
5705 do i=iphid_start,iphid_end
5706 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5707 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5708 itori=itortyp(itype(i-2))
5709 itori1=itortyp(itype(i-1))
5710 itori2=itortyp(itype(i))
5716 if (iabs(itype(i+1)).eq.20) iblock=2
5718 C Regular cosine and sine terms
5719 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5720 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5721 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5722 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5723 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5724 cosphi1=dcos(j*phii)
5725 sinphi1=dsin(j*phii)
5726 cosphi2=dcos(j*phii1)
5727 sinphi2=dsin(j*phii1)
5728 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5729 & v2cij*cosphi2+v2sij*sinphi2
5730 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5731 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5733 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5735 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5736 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5737 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5738 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5739 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5740 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5741 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5742 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5743 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5744 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5745 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5746 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5747 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5748 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5751 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5752 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5757 c------------------------------------------------------------------------------
5758 subroutine eback_sc_corr(esccor)
5759 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5760 c conformational states; temporarily implemented as differences
5761 c between UNRES torsional potentials (dependent on three types of
5762 c residues) and the torsional potentials dependent on all 20 types
5763 c of residues computed from AM1 energy surfaces of terminally-blocked
5764 c amino-acid residues.
5765 implicit real*8 (a-h,o-z)
5766 include 'DIMENSIONS'
5767 include 'COMMON.VAR'
5768 include 'COMMON.GEO'
5769 include 'COMMON.LOCAL'
5770 include 'COMMON.TORSION'
5771 include 'COMMON.SCCOR'
5772 include 'COMMON.INTERACT'
5773 include 'COMMON.DERIV'
5774 include 'COMMON.CHAIN'
5775 include 'COMMON.NAMES'
5776 include 'COMMON.IOUNITS'
5777 include 'COMMON.FFIELD'
5778 include 'COMMON.CONTROL'
5780 C Set lprn=.true. for debugging
5783 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5785 do i=itau_start,itau_end
5786 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5788 isccori=isccortyp(itype(i-2))
5789 isccori1=isccortyp(itype(i-1))
5790 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5792 do intertyp=1,3 !intertyp
5793 cc Added 09 May 2012 (Adasko)
5794 cc Intertyp means interaction type of backbone mainchain correlation:
5795 c 1 = SC...Ca...Ca...Ca
5796 c 2 = Ca...Ca...Ca...SC
5797 c 3 = SC...Ca...Ca...SCi
5799 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5800 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5801 & (itype(i-1).eq.ntyp1)))
5802 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5803 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5804 & .or.(itype(i).eq.ntyp1)))
5805 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5806 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5807 & (itype(i-3).eq.ntyp1)))) cycle
5808 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5809 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5811 do j=1,nterm_sccor(isccori,isccori1)
5812 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5813 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5814 cosphi=dcos(j*tauangle(intertyp,i))
5815 sinphi=dsin(j*tauangle(intertyp,i))
5816 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5817 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5819 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5820 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5822 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5823 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
5824 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
5825 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5826 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5832 c----------------------------------------------------------------------------
5833 subroutine multibody(ecorr)
5834 C This subroutine calculates multi-body contributions to energy following
5835 C the idea of Skolnick et al. If side chains I and J make a contact and
5836 C at the same time side chains I+1 and J+1 make a contact, an extra
5837 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5838 implicit real*8 (a-h,o-z)
5839 include 'DIMENSIONS'
5840 include 'COMMON.IOUNITS'
5841 include 'COMMON.DERIV'
5842 include 'COMMON.INTERACT'
5843 include 'COMMON.CONTACTS'
5844 double precision gx(3),gx1(3)
5847 C Set lprn=.true. for debugging
5851 write (iout,'(a)') 'Contact function values:'
5853 write (iout,'(i2,20(1x,i2,f10.5))')
5854 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5869 num_conti=num_cont(i)
5870 num_conti1=num_cont(i1)
5875 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5876 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5877 cd & ' ishift=',ishift
5878 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5879 C The system gains extra energy.
5880 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5881 endif ! j1==j+-ishift
5890 c------------------------------------------------------------------------------
5891 double precision function esccorr(i,j,k,l,jj,kk)
5892 implicit real*8 (a-h,o-z)
5893 include 'DIMENSIONS'
5894 include 'COMMON.IOUNITS'
5895 include 'COMMON.DERIV'
5896 include 'COMMON.INTERACT'
5897 include 'COMMON.CONTACTS'
5898 double precision gx(3),gx1(3)
5903 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5904 C Calculate the multi-body contribution to energy.
5905 C Calculate multi-body contributions to the gradient.
5906 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5907 cd & k,l,(gacont(m,kk,k),m=1,3)
5909 gx(m) =ekl*gacont(m,jj,i)
5910 gx1(m)=eij*gacont(m,kk,k)
5911 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5912 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5913 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5914 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5918 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5923 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5929 c------------------------------------------------------------------------------
5930 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5931 C This subroutine calculates multi-body contributions to hydrogen-bonding
5932 implicit real*8 (a-h,o-z)
5933 include 'DIMENSIONS'
5934 include 'COMMON.IOUNITS'
5937 parameter (max_cont=maxconts)
5938 parameter (max_dim=26)
5939 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5940 double precision zapas(max_dim,maxconts,max_fg_procs),
5941 & zapas_recv(max_dim,maxconts,max_fg_procs)
5942 common /przechowalnia/ zapas
5943 integer status(MPI_STATUS_SIZE),req(maxconts*2),
5944 & status_array(MPI_STATUS_SIZE,maxconts*2)
5946 include 'COMMON.SETUP'
5947 include 'COMMON.FFIELD'
5948 include 'COMMON.DERIV'
5949 include 'COMMON.INTERACT'
5950 include 'COMMON.CONTACTS'
5951 include 'COMMON.CONTROL'
5952 include 'COMMON.LOCAL'
5953 double precision gx(3),gx1(3),time00
5956 C Set lprn=.true. for debugging
5961 if (nfgtasks.le.1) goto 30
5963 write (iout,'(a)') 'Contact function values before RECEIVE:'
5965 write (iout,'(2i3,50(1x,i2,f5.2))')
5966 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5967 & j=1,num_cont_hb(i))
5971 do i=1,ntask_cont_from
5974 do i=1,ntask_cont_to
5977 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
5979 C Make the list of contacts to send to send to other procesors
5980 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
5982 do i=iturn3_start,iturn3_end
5983 c write (iout,*) "make contact list turn3",i," num_cont",
5985 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
5987 do i=iturn4_start,iturn4_end
5988 c write (iout,*) "make contact list turn4",i," num_cont",
5990 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
5994 c write (iout,*) "make contact list longrange",i,ii," num_cont",
5996 do j=1,num_cont_hb(i)
5999 iproc=iint_sent_local(k,jjc,ii)
6000 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6001 if (iproc.gt.0) then
6002 ncont_sent(iproc)=ncont_sent(iproc)+1
6003 nn=ncont_sent(iproc)
6005 zapas(2,nn,iproc)=jjc
6006 zapas(3,nn,iproc)=facont_hb(j,i)
6007 zapas(4,nn,iproc)=ees0p(j,i)
6008 zapas(5,nn,iproc)=ees0m(j,i)
6009 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6010 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6011 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6012 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6013 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6014 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6015 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6016 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6017 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6018 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6019 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6020 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6021 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6022 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6023 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6024 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6025 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6026 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6027 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6028 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6029 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6036 & "Numbers of contacts to be sent to other processors",
6037 & (ncont_sent(i),i=1,ntask_cont_to)
6038 write (iout,*) "Contacts sent"
6039 do ii=1,ntask_cont_to
6041 iproc=itask_cont_to(ii)
6042 write (iout,*) nn," contacts to processor",iproc,
6043 & " of CONT_TO_COMM group"
6045 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6053 CorrelID1=nfgtasks+fg_rank+1
6055 C Receive the numbers of needed contacts from other processors
6056 do ii=1,ntask_cont_from
6057 iproc=itask_cont_from(ii)
6059 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6060 & FG_COMM,req(ireq),IERR)
6062 c write (iout,*) "IRECV ended"
6064 C Send the number of contacts needed by other processors
6065 do ii=1,ntask_cont_to
6066 iproc=itask_cont_to(ii)
6068 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6069 & FG_COMM,req(ireq),IERR)
6071 c write (iout,*) "ISEND ended"
6072 c write (iout,*) "number of requests (nn)",ireq
6075 & call MPI_Waitall(ireq,req,status_array,ierr)
6077 c & "Numbers of contacts to be received from other processors",
6078 c & (ncont_recv(i),i=1,ntask_cont_from)
6082 do ii=1,ntask_cont_from
6083 iproc=itask_cont_from(ii)
6085 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6086 c & " of CONT_TO_COMM group"
6090 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6091 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6092 c write (iout,*) "ireq,req",ireq,req(ireq)
6095 C Send the contacts to processors that need them
6096 do ii=1,ntask_cont_to
6097 iproc=itask_cont_to(ii)
6099 c write (iout,*) nn," contacts to processor",iproc,
6100 c & " of CONT_TO_COMM group"
6103 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6104 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6105 c write (iout,*) "ireq,req",ireq,req(ireq)
6107 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6111 c write (iout,*) "number of requests (contacts)",ireq
6112 c write (iout,*) "req",(req(i),i=1,4)
6115 & call MPI_Waitall(ireq,req,status_array,ierr)
6116 do iii=1,ntask_cont_from
6117 iproc=itask_cont_from(iii)
6120 write (iout,*) "Received",nn," contacts from processor",iproc,
6121 & " of CONT_FROM_COMM group"
6124 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6129 ii=zapas_recv(1,i,iii)
6130 c Flag the received contacts to prevent double-counting
6131 jj=-zapas_recv(2,i,iii)
6132 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6134 nnn=num_cont_hb(ii)+1
6137 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6138 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6139 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6140 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6141 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6142 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6143 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6144 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6145 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6146 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6147 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6148 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6149 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6150 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6151 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6152 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6153 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6154 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6155 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6156 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6157 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6158 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6159 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6160 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6165 write (iout,'(a)') 'Contact function values after receive:'
6167 write (iout,'(2i3,50(1x,i3,f5.2))')
6168 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6169 & j=1,num_cont_hb(i))
6176 write (iout,'(a)') 'Contact function values:'
6178 write (iout,'(2i3,50(1x,i3,f5.2))')
6179 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6180 & j=1,num_cont_hb(i))
6184 C Remove the loop below after debugging !!!
6191 C Calculate the local-electrostatic correlation terms
6192 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6194 num_conti=num_cont_hb(i)
6195 num_conti1=num_cont_hb(i+1)
6202 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6203 c & ' jj=',jj,' kk=',kk
6204 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6205 & .or. j.lt.0 .and. j1.gt.0) .and.
6206 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6207 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6208 C The system gains extra energy.
6209 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6210 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6211 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6213 else if (j1.eq.j) then
6214 C Contacts I-J and I-(J+1) occur simultaneously.
6215 C The system loses extra energy.
6216 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6221 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6222 c & ' jj=',jj,' kk=',kk
6224 C Contacts I-J and (I+1)-J occur simultaneously.
6225 C The system loses extra energy.
6226 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6233 c------------------------------------------------------------------------------
6234 subroutine add_hb_contact(ii,jj,itask)
6235 implicit real*8 (a-h,o-z)
6236 include "DIMENSIONS"
6237 include "COMMON.IOUNITS"
6240 parameter (max_cont=maxconts)
6241 parameter (max_dim=26)
6242 include "COMMON.CONTACTS"
6243 double precision zapas(max_dim,maxconts,max_fg_procs),
6244 & zapas_recv(max_dim,maxconts,max_fg_procs)
6245 common /przechowalnia/ zapas
6246 integer i,j,ii,jj,iproc,itask(4),nn
6247 c write (iout,*) "itask",itask
6250 if (iproc.gt.0) then
6251 do j=1,num_cont_hb(ii)
6253 c write (iout,*) "i",ii," j",jj," jjc",jjc
6255 ncont_sent(iproc)=ncont_sent(iproc)+1
6256 nn=ncont_sent(iproc)
6257 zapas(1,nn,iproc)=ii
6258 zapas(2,nn,iproc)=jjc
6259 zapas(3,nn,iproc)=facont_hb(j,ii)
6260 zapas(4,nn,iproc)=ees0p(j,ii)
6261 zapas(5,nn,iproc)=ees0m(j,ii)
6262 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6263 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6264 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6265 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6266 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6267 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6268 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6269 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6270 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6271 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6272 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6273 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6274 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6275 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6276 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6277 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6278 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6279 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6280 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6281 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6282 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6290 c------------------------------------------------------------------------------
6291 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6293 C This subroutine calculates multi-body contributions to hydrogen-bonding
6294 implicit real*8 (a-h,o-z)
6295 include 'DIMENSIONS'
6296 include 'COMMON.IOUNITS'
6299 parameter (max_cont=maxconts)
6300 parameter (max_dim=70)
6301 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6302 double precision zapas(max_dim,maxconts,max_fg_procs),
6303 & zapas_recv(max_dim,maxconts,max_fg_procs)
6304 common /przechowalnia/ zapas
6305 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6306 & status_array(MPI_STATUS_SIZE,maxconts*2)
6308 include 'COMMON.SETUP'
6309 include 'COMMON.FFIELD'
6310 include 'COMMON.DERIV'
6311 include 'COMMON.LOCAL'
6312 include 'COMMON.INTERACT'
6313 include 'COMMON.CONTACTS'
6314 include 'COMMON.CHAIN'
6315 include 'COMMON.CONTROL'
6316 double precision gx(3),gx1(3)
6317 integer num_cont_hb_old(maxres)
6319 double precision eello4,eello5,eelo6,eello_turn6
6320 external eello4,eello5,eello6,eello_turn6
6321 C Set lprn=.true. for debugging
6326 num_cont_hb_old(i)=num_cont_hb(i)
6330 if (nfgtasks.le.1) goto 30
6332 write (iout,'(a)') 'Contact function values before RECEIVE:'
6334 write (iout,'(2i3,50(1x,i2,f5.2))')
6335 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6336 & j=1,num_cont_hb(i))
6340 do i=1,ntask_cont_from
6343 do i=1,ntask_cont_to
6346 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6348 C Make the list of contacts to send to send to other procesors
6349 do i=iturn3_start,iturn3_end
6350 c write (iout,*) "make contact list turn3",i," num_cont",
6352 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6354 do i=iturn4_start,iturn4_end
6355 c write (iout,*) "make contact list turn4",i," num_cont",
6357 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6361 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6363 do j=1,num_cont_hb(i)
6366 iproc=iint_sent_local(k,jjc,ii)
6367 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6368 if (iproc.ne.0) then
6369 ncont_sent(iproc)=ncont_sent(iproc)+1
6370 nn=ncont_sent(iproc)
6372 zapas(2,nn,iproc)=jjc
6373 zapas(3,nn,iproc)=d_cont(j,i)
6377 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6382 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6390 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6401 & "Numbers of contacts to be sent to other processors",
6402 & (ncont_sent(i),i=1,ntask_cont_to)
6403 write (iout,*) "Contacts sent"
6404 do ii=1,ntask_cont_to
6406 iproc=itask_cont_to(ii)
6407 write (iout,*) nn," contacts to processor",iproc,
6408 & " of CONT_TO_COMM group"
6410 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6418 CorrelID1=nfgtasks+fg_rank+1
6420 C Receive the numbers of needed contacts from other processors
6421 do ii=1,ntask_cont_from
6422 iproc=itask_cont_from(ii)
6424 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6425 & FG_COMM,req(ireq),IERR)
6427 c write (iout,*) "IRECV ended"
6429 C Send the number of contacts needed by other processors
6430 do ii=1,ntask_cont_to
6431 iproc=itask_cont_to(ii)
6433 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6434 & FG_COMM,req(ireq),IERR)
6436 c write (iout,*) "ISEND ended"
6437 c write (iout,*) "number of requests (nn)",ireq
6440 & call MPI_Waitall(ireq,req,status_array,ierr)
6442 c & "Numbers of contacts to be received from other processors",
6443 c & (ncont_recv(i),i=1,ntask_cont_from)
6447 do ii=1,ntask_cont_from
6448 iproc=itask_cont_from(ii)
6450 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6451 c & " of CONT_TO_COMM group"
6455 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6456 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6457 c write (iout,*) "ireq,req",ireq,req(ireq)
6460 C Send the contacts to processors that need them
6461 do ii=1,ntask_cont_to
6462 iproc=itask_cont_to(ii)
6464 c write (iout,*) nn," contacts to processor",iproc,
6465 c & " of CONT_TO_COMM group"
6468 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6469 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6470 c write (iout,*) "ireq,req",ireq,req(ireq)
6472 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6476 c write (iout,*) "number of requests (contacts)",ireq
6477 c write (iout,*) "req",(req(i),i=1,4)
6480 & call MPI_Waitall(ireq,req,status_array,ierr)
6481 do iii=1,ntask_cont_from
6482 iproc=itask_cont_from(iii)
6485 write (iout,*) "Received",nn," contacts from processor",iproc,
6486 & " of CONT_FROM_COMM group"
6489 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6494 ii=zapas_recv(1,i,iii)
6495 c Flag the received contacts to prevent double-counting
6496 jj=-zapas_recv(2,i,iii)
6497 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6499 nnn=num_cont_hb(ii)+1
6502 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6506 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6511 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6519 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6528 write (iout,'(a)') 'Contact function values after receive:'
6530 write (iout,'(2i3,50(1x,i3,5f6.3))')
6531 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6532 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6539 write (iout,'(a)') 'Contact function values:'
6541 write (iout,'(2i3,50(1x,i2,5f6.3))')
6542 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6543 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6549 C Remove the loop below after debugging !!!
6556 C Calculate the dipole-dipole interaction energies
6557 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6558 do i=iatel_s,iatel_e+1
6559 num_conti=num_cont_hb(i)
6568 C Calculate the local-electrostatic correlation terms
6569 c write (iout,*) "gradcorr5 in eello5 before loop"
6571 c write (iout,'(i5,3f10.5)')
6572 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6574 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6575 c write (iout,*) "corr loop i",i
6577 num_conti=num_cont_hb(i)
6578 num_conti1=num_cont_hb(i+1)
6585 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6586 c & ' jj=',jj,' kk=',kk
6587 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6588 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6589 & .or. j.lt.0 .and. j1.gt.0) .and.
6590 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6591 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6592 C The system gains extra energy.
6594 sqd1=dsqrt(d_cont(jj,i))
6595 sqd2=dsqrt(d_cont(kk,i1))
6596 sred_geom = sqd1*sqd2
6597 IF (sred_geom.lt.cutoff_corr) THEN
6598 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6600 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6601 cd & ' jj=',jj,' kk=',kk
6602 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6603 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6605 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6606 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6609 cd write (iout,*) 'sred_geom=',sred_geom,
6610 cd & ' ekont=',ekont,' fprim=',fprimcont,
6611 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6612 cd write (iout,*) "g_contij",g_contij
6613 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6614 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6615 call calc_eello(i,jp,i+1,jp1,jj,kk)
6616 if (wcorr4.gt.0.0d0)
6617 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6618 if (energy_dec.and.wcorr4.gt.0.0d0)
6619 1 write (iout,'(a6,4i5,0pf7.3)')
6620 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6621 c write (iout,*) "gradcorr5 before eello5"
6623 c write (iout,'(i5,3f10.5)')
6624 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6626 if (wcorr5.gt.0.0d0)
6627 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6628 c write (iout,*) "gradcorr5 after eello5"
6630 c write (iout,'(i5,3f10.5)')
6631 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6633 if (energy_dec.and.wcorr5.gt.0.0d0)
6634 1 write (iout,'(a6,4i5,0pf7.3)')
6635 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6636 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6637 cd write(2,*)'ijkl',i,jp,i+1,jp1
6638 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6639 & .or. wturn6.eq.0.0d0))then
6640 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6641 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6642 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6643 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6644 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6645 cd & 'ecorr6=',ecorr6
6646 cd write (iout,'(4e15.5)') sred_geom,
6647 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6648 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6649 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6650 else if (wturn6.gt.0.0d0
6651 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6652 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6653 eturn6=eturn6+eello_turn6(i,jj,kk)
6654 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6655 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6656 cd write (2,*) 'multibody_eello:eturn6',eturn6
6665 num_cont_hb(i)=num_cont_hb_old(i)
6667 c write (iout,*) "gradcorr5 in eello5"
6669 c write (iout,'(i5,3f10.5)')
6670 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6674 c------------------------------------------------------------------------------
6675 subroutine add_hb_contact_eello(ii,jj,itask)
6676 implicit real*8 (a-h,o-z)
6677 include "DIMENSIONS"
6678 include "COMMON.IOUNITS"
6681 parameter (max_cont=maxconts)
6682 parameter (max_dim=70)
6683 include "COMMON.CONTACTS"
6684 double precision zapas(max_dim,maxconts,max_fg_procs),
6685 & zapas_recv(max_dim,maxconts,max_fg_procs)
6686 common /przechowalnia/ zapas
6687 integer i,j,ii,jj,iproc,itask(4),nn
6688 c write (iout,*) "itask",itask
6691 if (iproc.gt.0) then
6692 do j=1,num_cont_hb(ii)
6694 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6696 ncont_sent(iproc)=ncont_sent(iproc)+1
6697 nn=ncont_sent(iproc)
6698 zapas(1,nn,iproc)=ii
6699 zapas(2,nn,iproc)=jjc
6700 zapas(3,nn,iproc)=d_cont(j,ii)
6704 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6709 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6717 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6729 c------------------------------------------------------------------------------
6730 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6731 implicit real*8 (a-h,o-z)
6732 include 'DIMENSIONS'
6733 include 'COMMON.IOUNITS'
6734 include 'COMMON.DERIV'
6735 include 'COMMON.INTERACT'
6736 include 'COMMON.CONTACTS'
6737 double precision gx(3),gx1(3)
6747 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6748 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6749 C Following 4 lines for diagnostics.
6754 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6755 c & 'Contacts ',i,j,
6756 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6757 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6759 C Calculate the multi-body contribution to energy.
6760 c ecorr=ecorr+ekont*ees
6761 C Calculate multi-body contributions to the gradient.
6762 coeffpees0pij=coeffp*ees0pij
6763 coeffmees0mij=coeffm*ees0mij
6764 coeffpees0pkl=coeffp*ees0pkl
6765 coeffmees0mkl=coeffm*ees0mkl
6767 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6768 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6769 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6770 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6771 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6772 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6773 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6774 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6775 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6776 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6777 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6778 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6779 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6780 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6781 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6782 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6783 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6784 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6785 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6786 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6787 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6788 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6789 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6790 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6791 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6796 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6797 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6798 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6799 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6804 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6805 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6806 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6807 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6810 c write (iout,*) "ehbcorr",ekont*ees
6815 C---------------------------------------------------------------------------
6816 subroutine dipole(i,j,jj)
6817 implicit real*8 (a-h,o-z)
6818 include 'DIMENSIONS'
6819 include 'COMMON.IOUNITS'
6820 include 'COMMON.CHAIN'
6821 include 'COMMON.FFIELD'
6822 include 'COMMON.DERIV'
6823 include 'COMMON.INTERACT'
6824 include 'COMMON.CONTACTS'
6825 include 'COMMON.TORSION'
6826 include 'COMMON.VAR'
6827 include 'COMMON.GEO'
6828 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6830 iti1 = itortyp(itype(i+1))
6831 if (j.lt.nres-1) then
6832 itj1 = itortyp(itype(j+1))
6837 dipi(iii,1)=Ub2(iii,i)
6838 dipderi(iii)=Ub2der(iii,i)
6839 dipi(iii,2)=b1(iii,iti1)
6840 dipj(iii,1)=Ub2(iii,j)
6841 dipderj(iii)=Ub2der(iii,j)
6842 dipj(iii,2)=b1(iii,itj1)
6846 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6849 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6856 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6860 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6865 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6866 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6868 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6870 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6872 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6877 C---------------------------------------------------------------------------
6878 subroutine calc_eello(i,j,k,l,jj,kk)
6880 C This subroutine computes matrices and vectors needed to calculate
6881 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6883 implicit real*8 (a-h,o-z)
6884 include 'DIMENSIONS'
6885 include 'COMMON.IOUNITS'
6886 include 'COMMON.CHAIN'
6887 include 'COMMON.DERIV'
6888 include 'COMMON.INTERACT'
6889 include 'COMMON.CONTACTS'
6890 include 'COMMON.TORSION'
6891 include 'COMMON.VAR'
6892 include 'COMMON.GEO'
6893 include 'COMMON.FFIELD'
6894 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6895 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6898 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6899 cd & ' jj=',jj,' kk=',kk
6900 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6901 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6902 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6905 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6906 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6909 call transpose2(aa1(1,1),aa1t(1,1))
6910 call transpose2(aa2(1,1),aa2t(1,1))
6913 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6914 & aa1tder(1,1,lll,kkk))
6915 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6916 & aa2tder(1,1,lll,kkk))
6920 C parallel orientation of the two CA-CA-CA frames.
6922 iti=itortyp(itype(i))
6926 itk1=itortyp(itype(k+1))
6927 itj=itortyp(itype(j))
6928 if (l.lt.nres-1) then
6929 itl1=itortyp(itype(l+1))
6933 C A1 kernel(j+1) A2T
6935 cd write (iout,'(3f10.5,5x,3f10.5)')
6936 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6938 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6939 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6940 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6941 C Following matrices are needed only for 6-th order cumulants
6942 IF (wcorr6.gt.0.0d0) THEN
6943 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6944 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6945 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6946 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6947 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6948 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6949 & ADtEAderx(1,1,1,1,1,1))
6951 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6952 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6953 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6954 & ADtEA1derx(1,1,1,1,1,1))
6956 C End 6-th order cumulants
6959 cd write (2,*) 'In calc_eello6'
6961 cd write (2,*) 'iii=',iii
6963 cd write (2,*) 'kkk=',kkk
6965 cd write (2,'(3(2f10.5),5x)')
6966 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6971 call transpose2(EUgder(1,1,k),auxmat(1,1))
6972 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6973 call transpose2(EUg(1,1,k),auxmat(1,1))
6974 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6975 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6979 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6980 & EAEAderx(1,1,lll,kkk,iii,1))
6984 C A1T kernel(i+1) A2
6985 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6986 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6987 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6988 C Following matrices are needed only for 6-th order cumulants
6989 IF (wcorr6.gt.0.0d0) THEN
6990 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6991 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6992 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6993 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6994 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6995 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6996 & ADtEAderx(1,1,1,1,1,2))
6997 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6998 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6999 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7000 & ADtEA1derx(1,1,1,1,1,2))
7002 C End 6-th order cumulants
7003 call transpose2(EUgder(1,1,l),auxmat(1,1))
7004 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7005 call transpose2(EUg(1,1,l),auxmat(1,1))
7006 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7007 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7011 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7012 & EAEAderx(1,1,lll,kkk,iii,2))
7017 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7018 C They are needed only when the fifth- or the sixth-order cumulants are
7020 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7021 call transpose2(AEA(1,1,1),auxmat(1,1))
7022 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7023 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7024 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7025 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7026 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7027 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7028 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7029 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7030 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7031 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7032 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7033 call transpose2(AEA(1,1,2),auxmat(1,1))
7034 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7035 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7036 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7037 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7038 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7039 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7040 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7041 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7042 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7043 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7044 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7045 C Calculate the Cartesian derivatives of the vectors.
7049 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7050 call matvec2(auxmat(1,1),b1(1,iti),
7051 & AEAb1derx(1,lll,kkk,iii,1,1))
7052 call matvec2(auxmat(1,1),Ub2(1,i),
7053 & AEAb2derx(1,lll,kkk,iii,1,1))
7054 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7055 & AEAb1derx(1,lll,kkk,iii,2,1))
7056 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7057 & AEAb2derx(1,lll,kkk,iii,2,1))
7058 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7059 call matvec2(auxmat(1,1),b1(1,itj),
7060 & AEAb1derx(1,lll,kkk,iii,1,2))
7061 call matvec2(auxmat(1,1),Ub2(1,j),
7062 & AEAb2derx(1,lll,kkk,iii,1,2))
7063 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7064 & AEAb1derx(1,lll,kkk,iii,2,2))
7065 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7066 & AEAb2derx(1,lll,kkk,iii,2,2))
7073 C Antiparallel orientation of the two CA-CA-CA frames.
7075 iti=itortyp(itype(i))
7079 itk1=itortyp(itype(k+1))
7080 itl=itortyp(itype(l))
7081 itj=itortyp(itype(j))
7082 if (j.lt.nres-1) then
7083 itj1=itortyp(itype(j+1))
7087 C A2 kernel(j-1)T A1T
7088 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7089 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7090 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7091 C Following matrices are needed only for 6-th order cumulants
7092 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7093 & j.eq.i+4 .and. l.eq.i+3)) THEN
7094 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7095 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7096 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7097 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7098 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7099 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7100 & ADtEAderx(1,1,1,1,1,1))
7101 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7102 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7103 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7104 & ADtEA1derx(1,1,1,1,1,1))
7106 C End 6-th order cumulants
7107 call transpose2(EUgder(1,1,k),auxmat(1,1))
7108 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7109 call transpose2(EUg(1,1,k),auxmat(1,1))
7110 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7111 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7115 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7116 & EAEAderx(1,1,lll,kkk,iii,1))
7120 C A2T kernel(i+1)T A1
7121 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7122 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7123 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7124 C Following matrices are needed only for 6-th order cumulants
7125 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7126 & j.eq.i+4 .and. l.eq.i+3)) THEN
7127 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7128 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7129 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7130 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7131 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7132 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7133 & ADtEAderx(1,1,1,1,1,2))
7134 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7135 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7136 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7137 & ADtEA1derx(1,1,1,1,1,2))
7139 C End 6-th order cumulants
7140 call transpose2(EUgder(1,1,j),auxmat(1,1))
7141 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7142 call transpose2(EUg(1,1,j),auxmat(1,1))
7143 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7144 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7148 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7149 & EAEAderx(1,1,lll,kkk,iii,2))
7154 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7155 C They are needed only when the fifth- or the sixth-order cumulants are
7157 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7158 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7159 call transpose2(AEA(1,1,1),auxmat(1,1))
7160 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7161 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7162 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7163 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7164 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7165 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7166 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7167 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7168 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7169 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7170 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7171 call transpose2(AEA(1,1,2),auxmat(1,1))
7172 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7173 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7174 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7175 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7176 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7177 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7178 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7179 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7180 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7181 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7182 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7183 C Calculate the Cartesian derivatives of the vectors.
7187 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7188 call matvec2(auxmat(1,1),b1(1,iti),
7189 & AEAb1derx(1,lll,kkk,iii,1,1))
7190 call matvec2(auxmat(1,1),Ub2(1,i),
7191 & AEAb2derx(1,lll,kkk,iii,1,1))
7192 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7193 & AEAb1derx(1,lll,kkk,iii,2,1))
7194 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7195 & AEAb2derx(1,lll,kkk,iii,2,1))
7196 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7197 call matvec2(auxmat(1,1),b1(1,itl),
7198 & AEAb1derx(1,lll,kkk,iii,1,2))
7199 call matvec2(auxmat(1,1),Ub2(1,l),
7200 & AEAb2derx(1,lll,kkk,iii,1,2))
7201 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7202 & AEAb1derx(1,lll,kkk,iii,2,2))
7203 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7204 & AEAb2derx(1,lll,kkk,iii,2,2))
7213 C---------------------------------------------------------------------------
7214 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7215 & KK,KKderg,AKA,AKAderg,AKAderx)
7219 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7220 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7221 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7226 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7228 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7231 cd if (lprn) write (2,*) 'In kernel'
7233 cd if (lprn) write (2,*) 'kkk=',kkk
7235 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7236 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7238 cd write (2,*) 'lll=',lll
7239 cd write (2,*) 'iii=1'
7241 cd write (2,'(3(2f10.5),5x)')
7242 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7245 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7246 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7248 cd write (2,*) 'lll=',lll
7249 cd write (2,*) 'iii=2'
7251 cd write (2,'(3(2f10.5),5x)')
7252 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7259 C---------------------------------------------------------------------------
7260 double precision function eello4(i,j,k,l,jj,kk)
7261 implicit real*8 (a-h,o-z)
7262 include 'DIMENSIONS'
7263 include 'COMMON.IOUNITS'
7264 include 'COMMON.CHAIN'
7265 include 'COMMON.DERIV'
7266 include 'COMMON.INTERACT'
7267 include 'COMMON.CONTACTS'
7268 include 'COMMON.TORSION'
7269 include 'COMMON.VAR'
7270 include 'COMMON.GEO'
7271 double precision pizda(2,2),ggg1(3),ggg2(3)
7272 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7276 cd print *,'eello4:',i,j,k,l,jj,kk
7277 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7278 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7279 cold eij=facont_hb(jj,i)
7280 cold ekl=facont_hb(kk,k)
7282 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7283 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7284 gcorr_loc(k-1)=gcorr_loc(k-1)
7285 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7287 gcorr_loc(l-1)=gcorr_loc(l-1)
7288 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7290 gcorr_loc(j-1)=gcorr_loc(j-1)
7291 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7296 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7297 & -EAEAderx(2,2,lll,kkk,iii,1)
7298 cd derx(lll,kkk,iii)=0.0d0
7302 cd gcorr_loc(l-1)=0.0d0
7303 cd gcorr_loc(j-1)=0.0d0
7304 cd gcorr_loc(k-1)=0.0d0
7306 cd write (iout,*)'Contacts have occurred for peptide groups',
7307 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7308 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7309 if (j.lt.nres-1) then
7316 if (l.lt.nres-1) then
7324 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7325 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7326 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7327 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7328 cgrad ghalf=0.5d0*ggg1(ll)
7329 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7330 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7331 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7332 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7333 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7334 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7335 cgrad ghalf=0.5d0*ggg2(ll)
7336 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7337 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7338 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7339 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7340 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7341 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7345 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7350 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7355 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7360 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7364 cd write (2,*) iii,gcorr_loc(iii)
7367 cd write (2,*) 'ekont',ekont
7368 cd write (iout,*) 'eello4',ekont*eel4
7371 C---------------------------------------------------------------------------
7372 double precision function eello5(i,j,k,l,jj,kk)
7373 implicit real*8 (a-h,o-z)
7374 include 'DIMENSIONS'
7375 include 'COMMON.IOUNITS'
7376 include 'COMMON.CHAIN'
7377 include 'COMMON.DERIV'
7378 include 'COMMON.INTERACT'
7379 include 'COMMON.CONTACTS'
7380 include 'COMMON.TORSION'
7381 include 'COMMON.VAR'
7382 include 'COMMON.GEO'
7383 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7384 double precision ggg1(3),ggg2(3)
7385 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7390 C /l\ / \ \ / \ / \ / C
7391 C / \ / \ \ / \ / \ / C
7392 C j| o |l1 | o | o| o | | o |o C
7393 C \ |/k\| |/ \| / |/ \| |/ \| C
7394 C \i/ \ / \ / / \ / \ C
7396 C (I) (II) (III) (IV) C
7398 C eello5_1 eello5_2 eello5_3 eello5_4 C
7400 C Antiparallel chains C
7403 C /j\ / \ \ / \ / \ / C
7404 C / \ / \ \ / \ / \ / C
7405 C j1| o |l | o | o| o | | o |o C
7406 C \ |/k\| |/ \| / |/ \| |/ \| C
7407 C \i/ \ / \ / / \ / \ C
7409 C (I) (II) (III) (IV) C
7411 C eello5_1 eello5_2 eello5_3 eello5_4 C
7413 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7415 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7416 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7421 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7423 itk=itortyp(itype(k))
7424 itl=itortyp(itype(l))
7425 itj=itortyp(itype(j))
7430 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7431 cd & eel5_3_num,eel5_4_num)
7435 derx(lll,kkk,iii)=0.0d0
7439 cd eij=facont_hb(jj,i)
7440 cd ekl=facont_hb(kk,k)
7442 cd write (iout,*)'Contacts have occurred for peptide groups',
7443 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7445 C Contribution from the graph I.
7446 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7447 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7448 call transpose2(EUg(1,1,k),auxmat(1,1))
7449 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7450 vv(1)=pizda(1,1)-pizda(2,2)
7451 vv(2)=pizda(1,2)+pizda(2,1)
7452 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7453 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7454 C Explicit gradient in virtual-dihedral angles.
7455 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7456 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7457 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7458 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7459 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7460 vv(1)=pizda(1,1)-pizda(2,2)
7461 vv(2)=pizda(1,2)+pizda(2,1)
7462 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7463 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7464 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7465 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7466 vv(1)=pizda(1,1)-pizda(2,2)
7467 vv(2)=pizda(1,2)+pizda(2,1)
7469 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7470 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7471 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7473 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7474 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7475 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7477 C Cartesian gradient
7481 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7483 vv(1)=pizda(1,1)-pizda(2,2)
7484 vv(2)=pizda(1,2)+pizda(2,1)
7485 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7486 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7487 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7493 C Contribution from graph II
7494 call transpose2(EE(1,1,itk),auxmat(1,1))
7495 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7496 vv(1)=pizda(1,1)+pizda(2,2)
7497 vv(2)=pizda(2,1)-pizda(1,2)
7498 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7499 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7500 C Explicit gradient in virtual-dihedral angles.
7501 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7502 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7503 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7504 vv(1)=pizda(1,1)+pizda(2,2)
7505 vv(2)=pizda(2,1)-pizda(1,2)
7507 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7508 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7509 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7511 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7512 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7513 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7515 C Cartesian gradient
7519 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7521 vv(1)=pizda(1,1)+pizda(2,2)
7522 vv(2)=pizda(2,1)-pizda(1,2)
7523 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7524 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7525 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7533 C Parallel orientation
7534 C Contribution from graph III
7535 call transpose2(EUg(1,1,l),auxmat(1,1))
7536 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7537 vv(1)=pizda(1,1)-pizda(2,2)
7538 vv(2)=pizda(1,2)+pizda(2,1)
7539 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7540 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7541 C Explicit gradient in virtual-dihedral angles.
7542 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7543 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7544 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7545 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7546 vv(1)=pizda(1,1)-pizda(2,2)
7547 vv(2)=pizda(1,2)+pizda(2,1)
7548 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7549 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7550 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7551 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7552 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7553 vv(1)=pizda(1,1)-pizda(2,2)
7554 vv(2)=pizda(1,2)+pizda(2,1)
7555 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7556 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7557 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7558 C Cartesian gradient
7562 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7564 vv(1)=pizda(1,1)-pizda(2,2)
7565 vv(2)=pizda(1,2)+pizda(2,1)
7566 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7567 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7568 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7573 C Contribution from graph IV
7575 call transpose2(EE(1,1,itl),auxmat(1,1))
7576 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7577 vv(1)=pizda(1,1)+pizda(2,2)
7578 vv(2)=pizda(2,1)-pizda(1,2)
7579 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7580 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7581 C Explicit gradient in virtual-dihedral angles.
7582 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7583 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7584 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7585 vv(1)=pizda(1,1)+pizda(2,2)
7586 vv(2)=pizda(2,1)-pizda(1,2)
7587 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7588 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7589 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7590 C Cartesian gradient
7594 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7596 vv(1)=pizda(1,1)+pizda(2,2)
7597 vv(2)=pizda(2,1)-pizda(1,2)
7598 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7599 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7600 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7605 C Antiparallel orientation
7606 C Contribution from graph III
7608 call transpose2(EUg(1,1,j),auxmat(1,1))
7609 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7610 vv(1)=pizda(1,1)-pizda(2,2)
7611 vv(2)=pizda(1,2)+pizda(2,1)
7612 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7613 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7614 C Explicit gradient in virtual-dihedral angles.
7615 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7616 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7617 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7618 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7619 vv(1)=pizda(1,1)-pizda(2,2)
7620 vv(2)=pizda(1,2)+pizda(2,1)
7621 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7622 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7623 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7624 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7625 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7626 vv(1)=pizda(1,1)-pizda(2,2)
7627 vv(2)=pizda(1,2)+pizda(2,1)
7628 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7629 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7630 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7631 C Cartesian gradient
7635 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7637 vv(1)=pizda(1,1)-pizda(2,2)
7638 vv(2)=pizda(1,2)+pizda(2,1)
7639 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7640 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7641 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7646 C Contribution from graph IV
7648 call transpose2(EE(1,1,itj),auxmat(1,1))
7649 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7650 vv(1)=pizda(1,1)+pizda(2,2)
7651 vv(2)=pizda(2,1)-pizda(1,2)
7652 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7653 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7654 C Explicit gradient in virtual-dihedral angles.
7655 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7656 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7657 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7658 vv(1)=pizda(1,1)+pizda(2,2)
7659 vv(2)=pizda(2,1)-pizda(1,2)
7660 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7661 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7662 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7663 C Cartesian gradient
7667 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7669 vv(1)=pizda(1,1)+pizda(2,2)
7670 vv(2)=pizda(2,1)-pizda(1,2)
7671 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7672 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7673 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7679 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7680 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7681 cd write (2,*) 'ijkl',i,j,k,l
7682 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7683 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7685 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7686 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7687 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7688 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7689 if (j.lt.nres-1) then
7696 if (l.lt.nres-1) then
7706 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7707 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7708 C summed up outside the subrouine as for the other subroutines
7709 C handling long-range interactions. The old code is commented out
7710 C with "cgrad" to keep track of changes.
7712 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7713 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7714 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7715 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7716 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7717 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7718 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7719 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7720 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7721 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7723 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7724 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7725 cgrad ghalf=0.5d0*ggg1(ll)
7727 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7728 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7729 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7730 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7731 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7732 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7733 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7734 cgrad ghalf=0.5d0*ggg2(ll)
7736 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7737 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7738 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7739 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7740 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7741 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7746 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7747 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7752 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7753 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7759 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7764 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7768 cd write (2,*) iii,g_corr5_loc(iii)
7771 cd write (2,*) 'ekont',ekont
7772 cd write (iout,*) 'eello5',ekont*eel5
7775 c--------------------------------------------------------------------------
7776 double precision function eello6(i,j,k,l,jj,kk)
7777 implicit real*8 (a-h,o-z)
7778 include 'DIMENSIONS'
7779 include 'COMMON.IOUNITS'
7780 include 'COMMON.CHAIN'
7781 include 'COMMON.DERIV'
7782 include 'COMMON.INTERACT'
7783 include 'COMMON.CONTACTS'
7784 include 'COMMON.TORSION'
7785 include 'COMMON.VAR'
7786 include 'COMMON.GEO'
7787 include 'COMMON.FFIELD'
7788 double precision ggg1(3),ggg2(3)
7789 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7794 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7802 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7803 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7807 derx(lll,kkk,iii)=0.0d0
7811 cd eij=facont_hb(jj,i)
7812 cd ekl=facont_hb(kk,k)
7818 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7819 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7820 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7821 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7822 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7823 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7825 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7826 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7827 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7828 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7829 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7830 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7834 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7836 C If turn contributions are considered, they will be handled separately.
7837 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7838 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7839 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7840 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7841 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7842 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7843 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7845 if (j.lt.nres-1) then
7852 if (l.lt.nres-1) then
7860 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7861 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7862 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7863 cgrad ghalf=0.5d0*ggg1(ll)
7865 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7866 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7867 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7868 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7869 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7870 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7871 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7872 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7873 cgrad ghalf=0.5d0*ggg2(ll)
7874 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7876 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7877 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7878 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7879 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7880 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7881 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7886 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7887 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7892 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7893 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7899 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7904 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7908 cd write (2,*) iii,g_corr6_loc(iii)
7911 cd write (2,*) 'ekont',ekont
7912 cd write (iout,*) 'eello6',ekont*eel6
7915 c--------------------------------------------------------------------------
7916 double precision function eello6_graph1(i,j,k,l,imat,swap)
7917 implicit real*8 (a-h,o-z)
7918 include 'DIMENSIONS'
7919 include 'COMMON.IOUNITS'
7920 include 'COMMON.CHAIN'
7921 include 'COMMON.DERIV'
7922 include 'COMMON.INTERACT'
7923 include 'COMMON.CONTACTS'
7924 include 'COMMON.TORSION'
7925 include 'COMMON.VAR'
7926 include 'COMMON.GEO'
7927 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7931 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7933 C Parallel Antiparallel C
7939 C \ j|/k\| / \ |/k\|l / C
7944 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7945 itk=itortyp(itype(k))
7946 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7947 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7948 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7949 call transpose2(EUgC(1,1,k),auxmat(1,1))
7950 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7951 vv1(1)=pizda1(1,1)-pizda1(2,2)
7952 vv1(2)=pizda1(1,2)+pizda1(2,1)
7953 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7954 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7955 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7956 s5=scalar2(vv(1),Dtobr2(1,i))
7957 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7958 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7959 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7960 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7961 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7962 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7963 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7964 & +scalar2(vv(1),Dtobr2der(1,i)))
7965 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7966 vv1(1)=pizda1(1,1)-pizda1(2,2)
7967 vv1(2)=pizda1(1,2)+pizda1(2,1)
7968 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7969 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7971 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7972 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7973 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7974 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7975 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7977 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7978 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7979 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7980 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7981 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7983 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7984 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7985 vv1(1)=pizda1(1,1)-pizda1(2,2)
7986 vv1(2)=pizda1(1,2)+pizda1(2,1)
7987 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7988 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7989 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7990 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7999 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8000 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8001 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8002 call transpose2(EUgC(1,1,k),auxmat(1,1))
8003 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8005 vv1(1)=pizda1(1,1)-pizda1(2,2)
8006 vv1(2)=pizda1(1,2)+pizda1(2,1)
8007 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8008 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8009 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8010 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8011 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8012 s5=scalar2(vv(1),Dtobr2(1,i))
8013 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8019 c----------------------------------------------------------------------------
8020 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8021 implicit real*8 (a-h,o-z)
8022 include 'DIMENSIONS'
8023 include 'COMMON.IOUNITS'
8024 include 'COMMON.CHAIN'
8025 include 'COMMON.DERIV'
8026 include 'COMMON.INTERACT'
8027 include 'COMMON.CONTACTS'
8028 include 'COMMON.TORSION'
8029 include 'COMMON.VAR'
8030 include 'COMMON.GEO'
8032 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8033 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8036 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8038 C Parallel Antiparallel C
8044 C \ j|/k\| \ |/k\|l C
8049 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8050 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8051 C AL 7/4/01 s1 would occur in the sixth-order moment,
8052 C but not in a cluster cumulant
8054 s1=dip(1,jj,i)*dip(1,kk,k)
8056 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8057 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8058 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8059 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8060 call transpose2(EUg(1,1,k),auxmat(1,1))
8061 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8062 vv(1)=pizda(1,1)-pizda(2,2)
8063 vv(2)=pizda(1,2)+pizda(2,1)
8064 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8065 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8067 eello6_graph2=-(s1+s2+s3+s4)
8069 eello6_graph2=-(s2+s3+s4)
8072 C Derivatives in gamma(i-1)
8075 s1=dipderg(1,jj,i)*dip(1,kk,k)
8077 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8078 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8079 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8080 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8082 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8084 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8086 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8088 C Derivatives in gamma(k-1)
8090 s1=dip(1,jj,i)*dipderg(1,kk,k)
8092 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8093 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8094 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8095 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8096 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8097 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8098 vv(1)=pizda(1,1)-pizda(2,2)
8099 vv(2)=pizda(1,2)+pizda(2,1)
8100 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8102 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8104 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8106 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8107 C Derivatives in gamma(j-1) or gamma(l-1)
8110 s1=dipderg(3,jj,i)*dip(1,kk,k)
8112 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8113 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8114 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8115 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8116 vv(1)=pizda(1,1)-pizda(2,2)
8117 vv(2)=pizda(1,2)+pizda(2,1)
8118 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8121 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8123 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8126 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8127 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8129 C Derivatives in gamma(l-1) or gamma(j-1)
8132 s1=dip(1,jj,i)*dipderg(3,kk,k)
8134 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8135 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8136 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8137 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8138 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8139 vv(1)=pizda(1,1)-pizda(2,2)
8140 vv(2)=pizda(1,2)+pizda(2,1)
8141 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8144 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8146 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8149 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8150 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8152 C Cartesian derivatives.
8154 write (2,*) 'In eello6_graph2'
8156 write (2,*) 'iii=',iii
8158 write (2,*) 'kkk=',kkk
8160 write (2,'(3(2f10.5),5x)')
8161 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8171 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8173 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8176 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8178 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8179 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8181 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8182 call transpose2(EUg(1,1,k),auxmat(1,1))
8183 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8185 vv(1)=pizda(1,1)-pizda(2,2)
8186 vv(2)=pizda(1,2)+pizda(2,1)
8187 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8188 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8190 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8192 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8195 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8197 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8204 c----------------------------------------------------------------------------
8205 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8206 implicit real*8 (a-h,o-z)
8207 include 'DIMENSIONS'
8208 include 'COMMON.IOUNITS'
8209 include 'COMMON.CHAIN'
8210 include 'COMMON.DERIV'
8211 include 'COMMON.INTERACT'
8212 include 'COMMON.CONTACTS'
8213 include 'COMMON.TORSION'
8214 include 'COMMON.VAR'
8215 include 'COMMON.GEO'
8216 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8218 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8220 C Parallel Antiparallel C
8226 C j|/k\| / |/k\|l / C
8231 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8233 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8234 C energy moment and not to the cluster cumulant.
8235 iti=itortyp(itype(i))
8236 if (j.lt.nres-1) then
8237 itj1=itortyp(itype(j+1))
8241 itk=itortyp(itype(k))
8242 itk1=itortyp(itype(k+1))
8243 if (l.lt.nres-1) then
8244 itl1=itortyp(itype(l+1))
8249 s1=dip(4,jj,i)*dip(4,kk,k)
8251 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8252 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8253 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8254 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8255 call transpose2(EE(1,1,itk),auxmat(1,1))
8256 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8257 vv(1)=pizda(1,1)+pizda(2,2)
8258 vv(2)=pizda(2,1)-pizda(1,2)
8259 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8260 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8261 cd & "sum",-(s2+s3+s4)
8263 eello6_graph3=-(s1+s2+s3+s4)
8265 eello6_graph3=-(s2+s3+s4)
8268 C Derivatives in gamma(k-1)
8269 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8270 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8271 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8272 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8273 C Derivatives in gamma(l-1)
8274 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8275 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8276 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8277 vv(1)=pizda(1,1)+pizda(2,2)
8278 vv(2)=pizda(2,1)-pizda(1,2)
8279 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8280 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8281 C Cartesian derivatives.
8287 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8289 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8292 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8294 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8295 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8297 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8298 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8300 vv(1)=pizda(1,1)+pizda(2,2)
8301 vv(2)=pizda(2,1)-pizda(1,2)
8302 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8304 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8306 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8309 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8311 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8313 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8319 c----------------------------------------------------------------------------
8320 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8321 implicit real*8 (a-h,o-z)
8322 include 'DIMENSIONS'
8323 include 'COMMON.IOUNITS'
8324 include 'COMMON.CHAIN'
8325 include 'COMMON.DERIV'
8326 include 'COMMON.INTERACT'
8327 include 'COMMON.CONTACTS'
8328 include 'COMMON.TORSION'
8329 include 'COMMON.VAR'
8330 include 'COMMON.GEO'
8331 include 'COMMON.FFIELD'
8332 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8333 & auxvec1(2),auxmat1(2,2)
8335 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8337 C Parallel Antiparallel C
8343 C \ j|/k\| \ |/k\|l C
8348 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8350 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8351 C energy moment and not to the cluster cumulant.
8352 cd write (2,*) 'eello_graph4: wturn6',wturn6
8353 iti=itortyp(itype(i))
8354 itj=itortyp(itype(j))
8355 if (j.lt.nres-1) then
8356 itj1=itortyp(itype(j+1))
8360 itk=itortyp(itype(k))
8361 if (k.lt.nres-1) then
8362 itk1=itortyp(itype(k+1))
8366 itl=itortyp(itype(l))
8367 if (l.lt.nres-1) then
8368 itl1=itortyp(itype(l+1))
8372 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8373 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8374 cd & ' itl',itl,' itl1',itl1
8377 s1=dip(3,jj,i)*dip(3,kk,k)
8379 s1=dip(2,jj,j)*dip(2,kk,l)
8382 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8383 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8385 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8386 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8388 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8389 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8391 call transpose2(EUg(1,1,k),auxmat(1,1))
8392 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8393 vv(1)=pizda(1,1)-pizda(2,2)
8394 vv(2)=pizda(2,1)+pizda(1,2)
8395 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8396 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8398 eello6_graph4=-(s1+s2+s3+s4)
8400 eello6_graph4=-(s2+s3+s4)
8402 C Derivatives in gamma(i-1)
8406 s1=dipderg(2,jj,i)*dip(3,kk,k)
8408 s1=dipderg(4,jj,j)*dip(2,kk,l)
8411 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8413 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8414 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8416 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8417 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8419 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8420 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8421 cd write (2,*) 'turn6 derivatives'
8423 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8425 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8429 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8431 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8435 C Derivatives in gamma(k-1)
8438 s1=dip(3,jj,i)*dipderg(2,kk,k)
8440 s1=dip(2,jj,j)*dipderg(4,kk,l)
8443 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8444 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8446 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8447 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8449 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8450 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8452 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8453 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8454 vv(1)=pizda(1,1)-pizda(2,2)
8455 vv(2)=pizda(2,1)+pizda(1,2)
8456 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8457 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8459 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8461 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8465 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8467 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8470 C Derivatives in gamma(j-1) or gamma(l-1)
8471 if (l.eq.j+1 .and. l.gt.1) then
8472 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8473 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8474 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8475 vv(1)=pizda(1,1)-pizda(2,2)
8476 vv(2)=pizda(2,1)+pizda(1,2)
8477 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8478 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8479 else if (j.gt.1) then
8480 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8481 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8482 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8483 vv(1)=pizda(1,1)-pizda(2,2)
8484 vv(2)=pizda(2,1)+pizda(1,2)
8485 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8486 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8487 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8489 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8492 C Cartesian derivatives.
8499 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8501 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8505 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8507 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8511 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8513 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8515 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8516 & b1(1,itj1),auxvec(1))
8517 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8519 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8520 & b1(1,itl1),auxvec(1))
8521 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8523 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8525 vv(1)=pizda(1,1)-pizda(2,2)
8526 vv(2)=pizda(2,1)+pizda(1,2)
8527 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8529 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8531 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8534 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8537 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8540 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8542 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8544 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8548 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8550 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8553 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8555 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8563 c----------------------------------------------------------------------------
8564 double precision function eello_turn6(i,jj,kk)
8565 implicit real*8 (a-h,o-z)
8566 include 'DIMENSIONS'
8567 include 'COMMON.IOUNITS'
8568 include 'COMMON.CHAIN'
8569 include 'COMMON.DERIV'
8570 include 'COMMON.INTERACT'
8571 include 'COMMON.CONTACTS'
8572 include 'COMMON.TORSION'
8573 include 'COMMON.VAR'
8574 include 'COMMON.GEO'
8575 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8576 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8578 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8579 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8580 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8581 C the respective energy moment and not to the cluster cumulant.
8590 iti=itortyp(itype(i))
8591 itk=itortyp(itype(k))
8592 itk1=itortyp(itype(k+1))
8593 itl=itortyp(itype(l))
8594 itj=itortyp(itype(j))
8595 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8596 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8597 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8602 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8604 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8608 derx_turn(lll,kkk,iii)=0.0d0
8615 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8617 cd write (2,*) 'eello6_5',eello6_5
8619 call transpose2(AEA(1,1,1),auxmat(1,1))
8620 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8621 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8622 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8624 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8625 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8626 s2 = scalar2(b1(1,itk),vtemp1(1))
8628 call transpose2(AEA(1,1,2),atemp(1,1))
8629 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8630 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8631 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8633 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8634 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8635 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8637 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8638 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8639 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8640 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8641 ss13 = scalar2(b1(1,itk),vtemp4(1))
8642 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8644 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8650 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8651 C Derivatives in gamma(i+2)
8655 call transpose2(AEA(1,1,1),auxmatd(1,1))
8656 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8657 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8658 call transpose2(AEAderg(1,1,2),atempd(1,1))
8659 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8660 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8662 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8663 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8664 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8670 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8671 C Derivatives in gamma(i+3)
8673 call transpose2(AEA(1,1,1),auxmatd(1,1))
8674 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8675 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8676 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8678 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8679 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8680 s2d = scalar2(b1(1,itk),vtemp1d(1))
8682 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8683 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8685 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8687 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8688 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8689 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8697 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8698 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8700 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8701 & -0.5d0*ekont*(s2d+s12d)
8703 C Derivatives in gamma(i+4)
8704 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8705 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8706 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8708 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8709 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8710 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8718 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8720 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8722 C Derivatives in gamma(i+5)
8724 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8725 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8726 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8728 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8729 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8730 s2d = scalar2(b1(1,itk),vtemp1d(1))
8732 call transpose2(AEA(1,1,2),atempd(1,1))
8733 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8734 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8736 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8737 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8739 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8740 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8741 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8749 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8750 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8752 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8753 & -0.5d0*ekont*(s2d+s12d)
8755 C Cartesian derivatives
8760 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8761 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8762 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8764 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8765 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8767 s2d = scalar2(b1(1,itk),vtemp1d(1))
8769 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8770 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8771 s8d = -(atempd(1,1)+atempd(2,2))*
8772 & scalar2(cc(1,1,itl),vtemp2(1))
8774 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8776 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8777 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8784 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8787 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8791 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8792 & - 0.5d0*(s8d+s12d)
8794 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8803 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8805 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8806 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8807 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8808 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8809 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8811 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8812 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8813 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8817 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8818 cd & 16*eel_turn6_num
8820 if (j.lt.nres-1) then
8827 if (l.lt.nres-1) then
8835 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8836 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8837 cgrad ghalf=0.5d0*ggg1(ll)
8839 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8840 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8841 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8842 & +ekont*derx_turn(ll,2,1)
8843 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8844 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8845 & +ekont*derx_turn(ll,4,1)
8846 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8847 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8848 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8849 cgrad ghalf=0.5d0*ggg2(ll)
8851 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8852 & +ekont*derx_turn(ll,2,2)
8853 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8854 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8855 & +ekont*derx_turn(ll,4,2)
8856 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8857 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8858 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8863 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8868 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8874 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8879 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8883 cd write (2,*) iii,g_corr6_loc(iii)
8885 eello_turn6=ekont*eel_turn6
8886 cd write (2,*) 'ekont',ekont
8887 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8891 C-----------------------------------------------------------------------------
8892 double precision function scalar(u,v)
8893 !DIR$ INLINEALWAYS scalar
8895 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8898 double precision u(3),v(3)
8899 cd double precision sc
8907 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8910 crc-------------------------------------------------
8911 SUBROUTINE MATVEC2(A1,V1,V2)
8912 !DIR$ INLINEALWAYS MATVEC2
8914 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8916 implicit real*8 (a-h,o-z)
8917 include 'DIMENSIONS'
8918 DIMENSION A1(2,2),V1(2),V2(2)
8922 c 3 VI=VI+A1(I,K)*V1(K)
8926 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8927 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8932 C---------------------------------------
8933 SUBROUTINE MATMAT2(A1,A2,A3)
8935 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8937 implicit real*8 (a-h,o-z)
8938 include 'DIMENSIONS'
8939 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8940 c DIMENSION AI3(2,2)
8944 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8950 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8951 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8952 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8953 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8961 c-------------------------------------------------------------------------
8962 double precision function scalar2(u,v)
8963 !DIR$ INLINEALWAYS scalar2
8965 double precision u(2),v(2)
8968 scalar2=u(1)*v(1)+u(2)*v(2)
8972 C-----------------------------------------------------------------------------
8974 subroutine transpose2(a,at)
8975 !DIR$ INLINEALWAYS transpose2
8977 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8980 double precision a(2,2),at(2,2)
8987 c--------------------------------------------------------------------------
8988 subroutine transpose(n,a,at)
8991 double precision a(n,n),at(n,n)
8999 C---------------------------------------------------------------------------
9000 subroutine prodmat3(a1,a2,kk,transp,prod)
9001 !DIR$ INLINEALWAYS prodmat3
9003 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9007 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9009 crc double precision auxmat(2,2),prod_(2,2)
9012 crc call transpose2(kk(1,1),auxmat(1,1))
9013 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9014 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9016 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9017 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9018 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9019 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9020 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9021 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9022 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9023 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9026 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9027 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9029 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9030 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9031 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9032 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9033 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9034 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9035 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9036 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9039 c call transpose2(a2(1,1),a2t(1,1))
9042 crc print *,((prod_(i,j),i=1,2),j=1,2)
9043 crc print *,((prod(i,j),i=1,2),j=1,2)