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
4085 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4086 & iabs(itype(jjj)).eq.1) then
4089 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4090 >>>>>>> prerelease-3.2.1
4091 call ssbond_ene(iii,jjj,eij)
4094 cd write (iout,*) "eij",eij
4097 C Calculate the distance between the two points and its difference from the
4101 C Get the force constant corresponding to this distance.
4103 C Calculate the contribution to energy.
4104 ehpb=ehpb+waga*rdis*rdis
4106 C Evaluate gradient.
4109 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4110 cd & ' waga=',waga,' fac=',fac
4112 ggg(j)=fac*(c(j,jj)-c(j,ii))
4114 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4115 C If this is a SC-SC distance, we need to calculate the contributions to the
4116 C Cartesian gradient in the SC vectors (ghpbx).
4119 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4120 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4123 cgrad do j=iii,jjj-1
4125 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4129 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4130 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4137 C--------------------------------------------------------------------------
4138 subroutine ssbond_ene(i,j,eij)
4140 C Calculate the distance and angle dependent SS-bond potential energy
4141 C using a free-energy function derived based on RHF/6-31G** ab initio
4142 C calculations of diethyl disulfide.
4144 C A. Liwo and U. Kozlowska, 11/24/03
4146 implicit real*8 (a-h,o-z)
4147 include 'DIMENSIONS'
4148 include 'COMMON.SBRIDGE'
4149 include 'COMMON.CHAIN'
4150 include 'COMMON.DERIV'
4151 include 'COMMON.LOCAL'
4152 include 'COMMON.INTERACT'
4153 include 'COMMON.VAR'
4154 include 'COMMON.IOUNITS'
4155 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4156 itypi=iabs(itype(i))
4160 dxi=dc_norm(1,nres+i)
4161 dyi=dc_norm(2,nres+i)
4162 dzi=dc_norm(3,nres+i)
4163 c dsci_inv=dsc_inv(itypi)
4164 dsci_inv=vbld_inv(nres+i)
4165 itypj=iabs(itype(j))
4166 c dscj_inv=dsc_inv(itypj)
4167 dscj_inv=vbld_inv(nres+j)
4171 dxj=dc_norm(1,nres+j)
4172 dyj=dc_norm(2,nres+j)
4173 dzj=dc_norm(3,nres+j)
4174 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4179 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4180 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4181 om12=dxi*dxj+dyi*dyj+dzi*dzj
4183 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4184 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4190 deltat12=om2-om1+2.0d0
4192 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4193 & +akct*deltad*deltat12
4194 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4195 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4196 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4197 c & " deltat12",deltat12," eij",eij
4198 ed=2*akcm*deltad+akct*deltat12
4200 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4201 eom1=-2*akth*deltat1-pom1-om2*pom2
4202 eom2= 2*akth*deltat2+pom1-om1*pom2
4205 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4206 ghpbx(k,i)=ghpbx(k,i)-ggk
4207 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4208 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4209 ghpbx(k,j)=ghpbx(k,j)+ggk
4210 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4211 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4212 ghpbc(k,i)=ghpbc(k,i)-ggk
4213 ghpbc(k,j)=ghpbc(k,j)+ggk
4216 C Calculate the components of the gradient in DC and X
4220 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4225 C--------------------------------------------------------------------------
4226 subroutine ebond(estr)
4228 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4230 implicit real*8 (a-h,o-z)
4231 include 'DIMENSIONS'
4232 include 'COMMON.LOCAL'
4233 include 'COMMON.GEO'
4234 include 'COMMON.INTERACT'
4235 include 'COMMON.DERIV'
4236 include 'COMMON.VAR'
4237 include 'COMMON.CHAIN'
4238 include 'COMMON.IOUNITS'
4239 include 'COMMON.NAMES'
4240 include 'COMMON.FFIELD'
4241 include 'COMMON.CONTROL'
4242 include 'COMMON.SETUP'
4243 double precision u(3),ud(3)
4246 do i=ibondp_start,ibondp_end
4247 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4248 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4250 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4251 & *dc(j,i-1)/vbld(i)
4253 if (energy_dec) write(iout,*)
4254 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4256 diff = vbld(i)-vbldp0
4257 if (energy_dec) write (iout,*)
4258 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4261 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4263 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4266 estr=0.5d0*AKP*estr+estr1
4268 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4270 do i=ibond_start,ibond_end
4272 if (iti.ne.10 .and. iti.ne.ntyp1) then
4275 diff=vbld(i+nres)-vbldsc0(1,iti)
4276 if (energy_dec) write (iout,*)
4277 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4278 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4279 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4281 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4285 diff=vbld(i+nres)-vbldsc0(j,iti)
4286 ud(j)=aksc(j,iti)*diff
4287 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4301 uprod2=uprod2*u(k)*u(k)
4305 usumsqder=usumsqder+ud(j)*uprod2
4307 estr=estr+uprod/usum
4309 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4317 C--------------------------------------------------------------------------
4318 subroutine ebend(etheta)
4320 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4321 C angles gamma and its derivatives in consecutive thetas and gammas.
4323 implicit real*8 (a-h,o-z)
4324 include 'DIMENSIONS'
4325 include 'COMMON.LOCAL'
4326 include 'COMMON.GEO'
4327 include 'COMMON.INTERACT'
4328 include 'COMMON.DERIV'
4329 include 'COMMON.VAR'
4330 include 'COMMON.CHAIN'
4331 include 'COMMON.IOUNITS'
4332 include 'COMMON.NAMES'
4333 include 'COMMON.FFIELD'
4334 include 'COMMON.CONTROL'
4335 common /calcthet/ term1,term2,termm,diffak,ratak,
4336 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4337 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4338 double precision y(2),z(2)
4340 c time11=dexp(-2*time)
4343 c write (*,'(a,i2)') 'EBEND ICG=',icg
4344 do i=ithet_start,ithet_end
4345 if (itype(i-1).eq.ntyp1) cycle
4346 C Zero the energy function and its derivative at 0 or pi.
4347 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4349 ichir1=isign(1,itype(i-2))
4350 ichir2=isign(1,itype(i))
4351 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4352 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4353 if (itype(i-1).eq.10) then
4354 itype1=isign(10,itype(i-2))
4355 ichir11=isign(1,itype(i-2))
4356 ichir12=isign(1,itype(i-2))
4357 itype2=isign(10,itype(i))
4358 ichir21=isign(1,itype(i))
4359 ichir22=isign(1,itype(i))
4362 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4365 if (phii.ne.phii) phii=150.0
4375 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4378 if (phii1.ne.phii1) phii1=150.0
4390 C Calculate the "mean" value of theta from the part of the distribution
4391 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4392 C In following comments this theta will be referred to as t_c.
4393 thet_pred_mean=0.0d0
4395 athetk=athet(k,it,ichir1,ichir2)
4396 bthetk=bthet(k,it,ichir1,ichir2)
4398 athetk=athet(k,itype1,ichir11,ichir12)
4399 bthetk=bthet(k,itype2,ichir21,ichir22)
4401 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4403 dthett=thet_pred_mean*ssd
4404 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4405 C Derivatives of the "mean" values in gamma1 and gamma2.
4406 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4407 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4408 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4409 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4411 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4412 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4413 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4414 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4416 if (theta(i).gt.pi-delta) then
4417 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4419 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4420 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4421 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4423 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4425 else if (theta(i).lt.delta) then
4426 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4427 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4428 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4430 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4431 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4434 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4437 etheta=etheta+ethetai
4438 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4440 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4441 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4442 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4444 C Ufff.... We've done all this!!!
4447 C---------------------------------------------------------------------------
4448 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4450 implicit real*8 (a-h,o-z)
4451 include 'DIMENSIONS'
4452 include 'COMMON.LOCAL'
4453 include 'COMMON.IOUNITS'
4454 common /calcthet/ term1,term2,termm,diffak,ratak,
4455 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4456 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4457 C Calculate the contributions to both Gaussian lobes.
4458 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4459 C The "polynomial part" of the "standard deviation" of this part of
4463 sig=sig*thet_pred_mean+polthet(j,it)
4465 C Derivative of the "interior part" of the "standard deviation of the"
4466 C gamma-dependent Gaussian lobe in t_c.
4467 sigtc=3*polthet(3,it)
4469 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4472 C Set the parameters of both Gaussian lobes of the distribution.
4473 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4474 fac=sig*sig+sigc0(it)
4477 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4478 sigsqtc=-4.0D0*sigcsq*sigtc
4479 c print *,i,sig,sigtc,sigsqtc
4480 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4481 sigtc=-sigtc/(fac*fac)
4482 C Following variable is sigma(t_c)**(-2)
4483 sigcsq=sigcsq*sigcsq
4485 sig0inv=1.0D0/sig0i**2
4486 delthec=thetai-thet_pred_mean
4487 delthe0=thetai-theta0i
4488 term1=-0.5D0*sigcsq*delthec*delthec
4489 term2=-0.5D0*sig0inv*delthe0*delthe0
4490 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4491 C NaNs in taking the logarithm. We extract the largest exponent which is added
4492 C to the energy (this being the log of the distribution) at the end of energy
4493 C term evaluation for this virtual-bond angle.
4494 if (term1.gt.term2) then
4496 term2=dexp(term2-termm)
4500 term1=dexp(term1-termm)
4503 C The ratio between the gamma-independent and gamma-dependent lobes of
4504 C the distribution is a Gaussian function of thet_pred_mean too.
4505 diffak=gthet(2,it)-thet_pred_mean
4506 ratak=diffak/gthet(3,it)**2
4507 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4508 C Let's differentiate it in thet_pred_mean NOW.
4510 C Now put together the distribution terms to make complete distribution.
4511 termexp=term1+ak*term2
4512 termpre=sigc+ak*sig0i
4513 C Contribution of the bending energy from this theta is just the -log of
4514 C the sum of the contributions from the two lobes and the pre-exponential
4515 C factor. Simple enough, isn't it?
4516 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4517 C NOW the derivatives!!!
4518 C 6/6/97 Take into account the deformation.
4519 E_theta=(delthec*sigcsq*term1
4520 & +ak*delthe0*sig0inv*term2)/termexp
4521 E_tc=((sigtc+aktc*sig0i)/termpre
4522 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4523 & aktc*term2)/termexp)
4526 c-----------------------------------------------------------------------------
4527 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4528 implicit real*8 (a-h,o-z)
4529 include 'DIMENSIONS'
4530 include 'COMMON.LOCAL'
4531 include 'COMMON.IOUNITS'
4532 common /calcthet/ term1,term2,termm,diffak,ratak,
4533 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4534 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4535 delthec=thetai-thet_pred_mean
4536 delthe0=thetai-theta0i
4537 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4538 t3 = thetai-thet_pred_mean
4542 t14 = t12+t6*sigsqtc
4544 t21 = thetai-theta0i
4550 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4551 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4552 & *(-t12*t9-ak*sig0inv*t27)
4556 C--------------------------------------------------------------------------
4557 subroutine ebend(etheta)
4559 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4560 C angles gamma and its derivatives in consecutive thetas and gammas.
4561 C ab initio-derived potentials from
4562 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4564 implicit real*8 (a-h,o-z)
4565 include 'DIMENSIONS'
4566 include 'COMMON.LOCAL'
4567 include 'COMMON.GEO'
4568 include 'COMMON.INTERACT'
4569 include 'COMMON.DERIV'
4570 include 'COMMON.VAR'
4571 include 'COMMON.CHAIN'
4572 include 'COMMON.IOUNITS'
4573 include 'COMMON.NAMES'
4574 include 'COMMON.FFIELD'
4575 include 'COMMON.CONTROL'
4576 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4577 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4578 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4579 & sinph1ph2(maxdouble,maxdouble)
4580 logical lprn /.false./, lprn1 /.false./
4582 do i=ithet_start,ithet_end
4583 if (itype(i-1).eq.ntyp1) cycle
4584 if (iabs(itype(i+1)).eq.20) iblock=2
4585 if (iabs(itype(i+1)).ne.20) iblock=1
4589 theti2=0.5d0*theta(i)
4590 ityp2=ithetyp((itype(i-1)))
4592 coskt(k)=dcos(k*theti2)
4593 sinkt(k)=dsin(k*theti2)
4595 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4598 if (phii.ne.phii) phii=150.0
4602 ityp1=ithetyp((itype(i-2)))
4603 C propagation of chirality for glycine type
4605 cosph1(k)=dcos(k*phii)
4606 sinph1(k)=dsin(k*phii)
4616 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4619 if (phii1.ne.phii1) phii1=150.0
4624 ityp3=ithetyp((itype(i)))
4626 cosph2(k)=dcos(k*phii1)
4627 sinph2(k)=dsin(k*phii1)
4637 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4640 ccl=cosph1(l)*cosph2(k-l)
4641 ssl=sinph1(l)*sinph2(k-l)
4642 scl=sinph1(l)*cosph2(k-l)
4643 csl=cosph1(l)*sinph2(k-l)
4644 cosph1ph2(l,k)=ccl-ssl
4645 cosph1ph2(k,l)=ccl+ssl
4646 sinph1ph2(l,k)=scl+csl
4647 sinph1ph2(k,l)=scl-csl
4651 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4652 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4653 write (iout,*) "coskt and sinkt"
4655 write (iout,*) k,coskt(k),sinkt(k)
4659 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4660 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4663 & write (iout,*) "k",k,"
4664 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4665 & " ethetai",ethetai
4668 write (iout,*) "cosph and sinph"
4670 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4672 write (iout,*) "cosph1ph2 and sinph2ph2"
4675 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4676 & sinph1ph2(l,k),sinph1ph2(k,l)
4679 write(iout,*) "ethetai",ethetai
4683 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4684 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4685 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4686 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4687 ethetai=ethetai+sinkt(m)*aux
4688 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4689 dephii=dephii+k*sinkt(m)*(
4690 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4691 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4692 dephii1=dephii1+k*sinkt(m)*(
4693 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4694 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4696 & write (iout,*) "m",m," k",k," bbthet",
4697 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4698 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4699 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4700 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4704 & write(iout,*) "ethetai",ethetai
4708 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4709 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4710 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4711 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4712 ethetai=ethetai+sinkt(m)*aux
4713 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4714 dephii=dephii+l*sinkt(m)*(
4715 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4716 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4717 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4718 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4719 dephii1=dephii1+(k-l)*sinkt(m)*(
4720 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4721 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4722 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4723 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4725 write (iout,*) "m",m," k",k," l",l," ffthet",
4726 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4727 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4728 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4729 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4730 & " ethetai",ethetai
4731 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4732 & cosph1ph2(k,l)*sinkt(m),
4733 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4741 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4742 & i,theta(i)*rad2deg,phii*rad2deg,
4743 & phii1*rad2deg,ethetai
4745 etheta=etheta+ethetai
4746 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4747 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4748 gloc(nphi+i-2,icg)=wang*dethetai
4754 c-----------------------------------------------------------------------------
4755 subroutine esc(escloc)
4756 C Calculate the local energy of a side chain and its derivatives in the
4757 C corresponding virtual-bond valence angles THETA and the spherical angles
4759 implicit real*8 (a-h,o-z)
4760 include 'DIMENSIONS'
4761 include 'COMMON.GEO'
4762 include 'COMMON.LOCAL'
4763 include 'COMMON.VAR'
4764 include 'COMMON.INTERACT'
4765 include 'COMMON.DERIV'
4766 include 'COMMON.CHAIN'
4767 include 'COMMON.IOUNITS'
4768 include 'COMMON.NAMES'
4769 include 'COMMON.FFIELD'
4770 include 'COMMON.CONTROL'
4771 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4772 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4773 common /sccalc/ time11,time12,time112,theti,it,nlobit
4776 c write (iout,'(a)') 'ESC'
4777 do i=loc_start,loc_end
4779 if (it.eq.ntyp1) cycle
4780 if (it.eq.10) goto 1
4781 nlobit=nlob(iabs(it))
4782 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4783 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4784 theti=theta(i+1)-pipol
4789 if (x(2).gt.pi-delta) then
4793 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4795 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4796 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4798 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4799 & ddersc0(1),dersc(1))
4800 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4801 & ddersc0(3),dersc(3))
4803 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4805 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4806 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4807 & dersc0(2),esclocbi,dersc02)
4808 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4810 call splinthet(x(2),0.5d0*delta,ss,ssd)
4815 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4817 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4818 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4820 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4822 c write (iout,*) escloci
4823 else if (x(2).lt.delta) then
4827 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4829 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4830 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4832 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4833 & ddersc0(1),dersc(1))
4834 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4835 & ddersc0(3),dersc(3))
4837 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4839 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4840 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4841 & dersc0(2),esclocbi,dersc02)
4842 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4847 call splinthet(x(2),0.5d0*delta,ss,ssd)
4849 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4851 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4852 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4854 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4855 c write (iout,*) escloci
4857 call enesc(x,escloci,dersc,ddummy,.false.)
4860 escloc=escloc+escloci
4861 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4862 & 'escloc',i,escloci
4863 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4865 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4867 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4868 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4873 C---------------------------------------------------------------------------
4874 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4875 implicit real*8 (a-h,o-z)
4876 include 'DIMENSIONS'
4877 include 'COMMON.GEO'
4878 include 'COMMON.LOCAL'
4879 include 'COMMON.IOUNITS'
4880 common /sccalc/ time11,time12,time112,theti,it,nlobit
4881 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4882 double precision contr(maxlob,-1:1)
4884 c write (iout,*) 'it=',it,' nlobit=',nlobit
4888 if (mixed) ddersc(j)=0.0d0
4892 C Because of periodicity of the dependence of the SC energy in omega we have
4893 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4894 C To avoid underflows, first compute & store the exponents.
4902 z(k)=x(k)-censc(k,j,it)
4907 Axk=Axk+gaussc(l,k,j,it)*z(l)
4913 expfac=expfac+Ax(k,j,iii)*z(k)
4921 C As in the case of ebend, we want to avoid underflows in exponentiation and
4922 C subsequent NaNs and INFs in energy calculation.
4923 C Find the largest exponent
4927 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4931 cd print *,'it=',it,' emin=',emin
4933 C Compute the contribution to SC energy and derivatives
4938 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
4939 if(adexp.ne.adexp) adexp=1.0
4942 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4944 cd print *,'j=',j,' expfac=',expfac
4945 escloc_i=escloc_i+expfac
4947 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4951 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4952 & +gaussc(k,2,j,it))*expfac
4959 dersc(1)=dersc(1)/cos(theti)**2
4960 ddersc(1)=ddersc(1)/cos(theti)**2
4963 escloci=-(dlog(escloc_i)-emin)
4965 dersc(j)=dersc(j)/escloc_i
4969 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4974 C------------------------------------------------------------------------------
4975 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4976 implicit real*8 (a-h,o-z)
4977 include 'DIMENSIONS'
4978 include 'COMMON.GEO'
4979 include 'COMMON.LOCAL'
4980 include 'COMMON.IOUNITS'
4981 common /sccalc/ time11,time12,time112,theti,it,nlobit
4982 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4983 double precision contr(maxlob)
4994 z(k)=x(k)-censc(k,j,it)
5000 Axk=Axk+gaussc(l,k,j,it)*z(l)
5006 expfac=expfac+Ax(k,j)*z(k)
5011 C As in the case of ebend, we want to avoid underflows in exponentiation and
5012 C subsequent NaNs and INFs in energy calculation.
5013 C Find the largest exponent
5016 if (emin.gt.contr(j)) emin=contr(j)
5020 C Compute the contribution to SC energy and derivatives
5024 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5025 escloc_i=escloc_i+expfac
5027 dersc(k)=dersc(k)+Ax(k,j)*expfac
5029 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5030 & +gaussc(1,2,j,it))*expfac
5034 dersc(1)=dersc(1)/cos(theti)**2
5035 dersc12=dersc12/cos(theti)**2
5036 escloci=-(dlog(escloc_i)-emin)
5038 dersc(j)=dersc(j)/escloc_i
5040 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5044 c----------------------------------------------------------------------------------
5045 subroutine esc(escloc)
5046 C Calculate the local energy of a side chain and its derivatives in the
5047 C corresponding virtual-bond valence angles THETA and the spherical angles
5048 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5049 C added by Urszula Kozlowska. 07/11/2007
5051 implicit real*8 (a-h,o-z)
5052 include 'DIMENSIONS'
5053 include 'COMMON.GEO'
5054 include 'COMMON.LOCAL'
5055 include 'COMMON.VAR'
5056 include 'COMMON.SCROT'
5057 include 'COMMON.INTERACT'
5058 include 'COMMON.DERIV'
5059 include 'COMMON.CHAIN'
5060 include 'COMMON.IOUNITS'
5061 include 'COMMON.NAMES'
5062 include 'COMMON.FFIELD'
5063 include 'COMMON.CONTROL'
5064 include 'COMMON.VECTORS'
5065 double precision x_prime(3),y_prime(3),z_prime(3)
5066 & , sumene,dsc_i,dp2_i,x(65),
5067 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5068 & de_dxx,de_dyy,de_dzz,de_dt
5069 double precision s1_t,s1_6_t,s2_t,s2_6_t
5071 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5072 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5073 & dt_dCi(3),dt_dCi1(3)
5074 common /sccalc/ time11,time12,time112,theti,it,nlobit
5077 do i=loc_start,loc_end
5078 if (itype(i).eq.ntyp1) cycle
5079 costtab(i+1) =dcos(theta(i+1))
5080 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5081 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5082 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5083 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5084 cosfac=dsqrt(cosfac2)
5085 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5086 sinfac=dsqrt(sinfac2)
5088 if (it.eq.10) goto 1
5090 C Compute the axes of tghe local cartesian coordinates system; store in
5091 c x_prime, y_prime and z_prime
5098 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5099 C & dc_norm(3,i+nres)
5101 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5102 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5105 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5108 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5109 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5110 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5111 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5112 c & " xy",scalar(x_prime(1),y_prime(1)),
5113 c & " xz",scalar(x_prime(1),z_prime(1)),
5114 c & " yy",scalar(y_prime(1),y_prime(1)),
5115 c & " yz",scalar(y_prime(1),z_prime(1)),
5116 c & " zz",scalar(z_prime(1),z_prime(1))
5118 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5119 C to local coordinate system. Store in xx, yy, zz.
5125 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5126 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5127 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5134 C Compute the energy of the ith side cbain
5136 c write (2,*) "xx",xx," yy",yy," zz",zz
5139 x(j) = sc_parmin(j,it)
5142 Cc diagnostics - remove later
5144 yy1 = dsin(alph(2))*dcos(omeg(2))
5145 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5146 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5147 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5149 C," --- ", xx_w,yy_w,zz_w
5152 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5153 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5155 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5156 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5158 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5159 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5160 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5161 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5162 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5164 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5165 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5166 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5167 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5168 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5170 dsc_i = 0.743d0+x(61)
5172 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5173 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5174 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5175 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5176 s1=(1+x(63))/(0.1d0 + dscp1)
5177 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5178 s2=(1+x(65))/(0.1d0 + dscp2)
5179 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5180 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5181 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5182 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5184 c & dscp1,dscp2,sumene
5185 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5186 escloc = escloc + sumene
5187 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5192 C This section to check the numerical derivatives of the energy of ith side
5193 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5194 C #define DEBUG in the code to turn it on.
5196 write (2,*) "sumene =",sumene
5200 write (2,*) xx,yy,zz
5201 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5202 de_dxx_num=(sumenep-sumene)/aincr
5204 write (2,*) "xx+ sumene from enesc=",sumenep
5207 write (2,*) xx,yy,zz
5208 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5209 de_dyy_num=(sumenep-sumene)/aincr
5211 write (2,*) "yy+ sumene from enesc=",sumenep
5214 write (2,*) xx,yy,zz
5215 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5216 de_dzz_num=(sumenep-sumene)/aincr
5218 write (2,*) "zz+ sumene from enesc=",sumenep
5219 costsave=cost2tab(i+1)
5220 sintsave=sint2tab(i+1)
5221 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5222 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5223 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5224 de_dt_num=(sumenep-sumene)/aincr
5225 write (2,*) " t+ sumene from enesc=",sumenep
5226 cost2tab(i+1)=costsave
5227 sint2tab(i+1)=sintsave
5228 C End of diagnostics section.
5231 C Compute the gradient of esc
5233 c zz=zz*dsign(1.0,dfloat(itype(i)))
5234 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5235 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5236 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5237 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5238 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5239 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5240 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5241 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5242 pom1=(sumene3*sint2tab(i+1)+sumene1)
5243 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5244 pom2=(sumene4*cost2tab(i+1)+sumene2)
5245 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5246 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5247 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5248 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5250 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5251 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5252 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5254 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5255 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5256 & +(pom1+pom2)*pom_dx
5258 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5261 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5262 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5263 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5265 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5266 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5267 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5268 & +x(59)*zz**2 +x(60)*xx*zz
5269 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5270 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5271 & +(pom1-pom2)*pom_dy
5273 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5276 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5277 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5278 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5279 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5280 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5281 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5282 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5283 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5285 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5288 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5289 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5290 & +pom1*pom_dt1+pom2*pom_dt2
5292 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5297 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5298 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5299 cosfac2xx=cosfac2*xx
5300 sinfac2yy=sinfac2*yy
5302 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5304 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5306 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5307 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5308 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5309 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5310 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5311 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5312 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5313 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5314 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5315 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5319 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5320 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5321 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5322 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5325 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5326 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5327 dZZ_XYZ(k)=vbld_inv(i+nres)*
5328 & (z_prime(k)-zz*dC_norm(k,i+nres))
5330 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5331 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5335 dXX_Ctab(k,i)=dXX_Ci(k)
5336 dXX_C1tab(k,i)=dXX_Ci1(k)
5337 dYY_Ctab(k,i)=dYY_Ci(k)
5338 dYY_C1tab(k,i)=dYY_Ci1(k)
5339 dZZ_Ctab(k,i)=dZZ_Ci(k)
5340 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5341 dXX_XYZtab(k,i)=dXX_XYZ(k)
5342 dYY_XYZtab(k,i)=dYY_XYZ(k)
5343 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5347 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5348 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5349 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5350 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5351 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5353 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5354 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5355 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5356 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5357 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5358 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5359 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5360 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5362 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5363 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5365 C to check gradient call subroutine check_grad
5371 c------------------------------------------------------------------------------
5372 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5374 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5375 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5376 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5377 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5379 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5380 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5382 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5383 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5384 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5385 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5386 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5388 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5389 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5390 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5391 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5392 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5394 dsc_i = 0.743d0+x(61)
5396 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5397 & *(xx*cost2+yy*sint2))
5398 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5399 & *(xx*cost2-yy*sint2))
5400 s1=(1+x(63))/(0.1d0 + dscp1)
5401 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5402 s2=(1+x(65))/(0.1d0 + dscp2)
5403 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5404 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5405 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5410 c------------------------------------------------------------------------------
5411 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5413 C This procedure calculates two-body contact function g(rij) and its derivative:
5416 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5419 C where x=(rij-r0ij)/delta
5421 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5424 double precision rij,r0ij,eps0ij,fcont,fprimcont
5425 double precision x,x2,x4,delta
5429 if (x.lt.-1.0D0) then
5432 else if (x.le.1.0D0) then
5435 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5436 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5443 c------------------------------------------------------------------------------
5444 subroutine splinthet(theti,delta,ss,ssder)
5445 implicit real*8 (a-h,o-z)
5446 include 'DIMENSIONS'
5447 include 'COMMON.VAR'
5448 include 'COMMON.GEO'
5451 if (theti.gt.pipol) then
5452 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5454 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5459 c------------------------------------------------------------------------------
5460 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5462 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5463 double precision ksi,ksi2,ksi3,a1,a2,a3
5464 a1=fprim0*delta/(f1-f0)
5470 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5471 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5474 c------------------------------------------------------------------------------
5475 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5477 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5478 double precision ksi,ksi2,ksi3,a1,a2,a3
5483 a2=3*(f1x-f0x)-2*fprim0x*delta
5484 a3=fprim0x*delta-2*(f1x-f0x)
5485 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5488 C-----------------------------------------------------------------------------
5490 C-----------------------------------------------------------------------------
5491 subroutine etor(etors,edihcnstr)
5492 implicit real*8 (a-h,o-z)
5493 include 'DIMENSIONS'
5494 include 'COMMON.VAR'
5495 include 'COMMON.GEO'
5496 include 'COMMON.LOCAL'
5497 include 'COMMON.TORSION'
5498 include 'COMMON.INTERACT'
5499 include 'COMMON.DERIV'
5500 include 'COMMON.CHAIN'
5501 include 'COMMON.NAMES'
5502 include 'COMMON.IOUNITS'
5503 include 'COMMON.FFIELD'
5504 include 'COMMON.TORCNSTR'
5505 include 'COMMON.CONTROL'
5507 C Set lprn=.true. for debugging
5511 do i=iphi_start,iphi_end
5513 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5514 & .or. itype(i).eq.ntyp1) cycle
5515 itori=itortyp(itype(i-2))
5516 itori1=itortyp(itype(i-1))
5519 C Proline-Proline pair is a special case...
5520 if (itori.eq.3 .and. itori1.eq.3) then
5521 if (phii.gt.-dwapi3) then
5523 fac=1.0D0/(1.0D0-cosphi)
5524 etorsi=v1(1,3,3)*fac
5525 etorsi=etorsi+etorsi
5526 etors=etors+etorsi-v1(1,3,3)
5527 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5528 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5531 v1ij=v1(j+1,itori,itori1)
5532 v2ij=v2(j+1,itori,itori1)
5535 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5536 if (energy_dec) etors_ii=etors_ii+
5537 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5538 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5542 v1ij=v1(j,itori,itori1)
5543 v2ij=v2(j,itori,itori1)
5546 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5547 if (energy_dec) etors_ii=etors_ii+
5548 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5549 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5552 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5555 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5556 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5557 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5558 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5559 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5561 ! 6/20/98 - dihedral angle constraints
5564 itori=idih_constr(i)
5567 if (difi.gt.drange(i)) then
5569 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5570 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5571 else if (difi.lt.-drange(i)) then
5573 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5574 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5576 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5577 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5579 ! write (iout,*) 'edihcnstr',edihcnstr
5582 c------------------------------------------------------------------------------
5583 subroutine etor_d(etors_d)
5587 c----------------------------------------------------------------------------
5589 subroutine etor(etors,edihcnstr)
5590 implicit real*8 (a-h,o-z)
5591 include 'DIMENSIONS'
5592 include 'COMMON.VAR'
5593 include 'COMMON.GEO'
5594 include 'COMMON.LOCAL'
5595 include 'COMMON.TORSION'
5596 include 'COMMON.INTERACT'
5597 include 'COMMON.DERIV'
5598 include 'COMMON.CHAIN'
5599 include 'COMMON.NAMES'
5600 include 'COMMON.IOUNITS'
5601 include 'COMMON.FFIELD'
5602 include 'COMMON.TORCNSTR'
5603 include 'COMMON.CONTROL'
5605 C Set lprn=.true. for debugging
5609 do i=iphi_start,iphi_end
5610 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5611 & .or. itype(i).eq.ntyp1) cycle
5613 if (iabs(itype(i)).eq.20) then
5618 itori=itortyp(itype(i-2))
5619 itori1=itortyp(itype(i-1))
5622 C Regular cosine and sine terms
5623 do j=1,nterm(itori,itori1,iblock)
5624 v1ij=v1(j,itori,itori1,iblock)
5625 v2ij=v2(j,itori,itori1,iblock)
5628 etors=etors+v1ij*cosphi+v2ij*sinphi
5629 if (energy_dec) etors_ii=etors_ii+
5630 & v1ij*cosphi+v2ij*sinphi
5631 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5635 C E = SUM ----------------------------------- - v1
5636 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5638 cosphi=dcos(0.5d0*phii)
5639 sinphi=dsin(0.5d0*phii)
5640 do j=1,nlor(itori,itori1,iblock)
5641 vl1ij=vlor1(j,itori,itori1)
5642 vl2ij=vlor2(j,itori,itori1)
5643 vl3ij=vlor3(j,itori,itori1)
5644 pom=vl2ij*cosphi+vl3ij*sinphi
5645 pom1=1.0d0/(pom*pom+1.0d0)
5646 etors=etors+vl1ij*pom1
5647 if (energy_dec) etors_ii=etors_ii+
5650 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5652 C Subtract the constant term
5653 etors=etors-v0(itori,itori1,iblock)
5654 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5655 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5657 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5658 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5659 & (v1(j,itori,itori1,iblock),j=1,6),
5660 & (v2(j,itori,itori1,iblock),j=1,6)
5661 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5662 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5664 ! 6/20/98 - dihedral angle constraints
5666 c do i=1,ndih_constr
5667 do i=idihconstr_start,idihconstr_end
5668 itori=idih_constr(i)
5670 difi=pinorm(phii-phi0(i))
5671 if (difi.gt.drange(i)) then
5673 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5674 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5675 else if (difi.lt.-drange(i)) then
5677 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5678 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5682 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5683 cd & rad2deg*phi0(i), rad2deg*drange(i),
5684 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5686 cd write (iout,*) 'edihcnstr',edihcnstr
5689 c----------------------------------------------------------------------------
5690 subroutine etor_d(etors_d)
5691 C 6/23/01 Compute double torsional energy
5692 implicit real*8 (a-h,o-z)
5693 include 'DIMENSIONS'
5694 include 'COMMON.VAR'
5695 include 'COMMON.GEO'
5696 include 'COMMON.LOCAL'
5697 include 'COMMON.TORSION'
5698 include 'COMMON.INTERACT'
5699 include 'COMMON.DERIV'
5700 include 'COMMON.CHAIN'
5701 include 'COMMON.NAMES'
5702 include 'COMMON.IOUNITS'
5703 include 'COMMON.FFIELD'
5704 include 'COMMON.TORCNSTR'
5706 C Set lprn=.true. for debugging
5710 c write(iout,*) "a tu??"
5711 do i=iphid_start,iphid_end
5712 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5713 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5714 itori=itortyp(itype(i-2))
5715 itori1=itortyp(itype(i-1))
5716 itori2=itortyp(itype(i))
5722 if (iabs(itype(i+1)).eq.20) iblock=2
5724 C Regular cosine and sine terms
5725 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5726 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5727 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5728 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5729 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5730 cosphi1=dcos(j*phii)
5731 sinphi1=dsin(j*phii)
5732 cosphi2=dcos(j*phii1)
5733 sinphi2=dsin(j*phii1)
5734 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5735 & v2cij*cosphi2+v2sij*sinphi2
5736 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5737 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5739 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5741 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5742 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5743 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5744 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5745 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5746 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5747 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5748 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5749 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5750 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5751 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5752 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5753 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5754 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5757 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5758 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5763 c------------------------------------------------------------------------------
5764 subroutine eback_sc_corr(esccor)
5765 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5766 c conformational states; temporarily implemented as differences
5767 c between UNRES torsional potentials (dependent on three types of
5768 c residues) and the torsional potentials dependent on all 20 types
5769 c of residues computed from AM1 energy surfaces of terminally-blocked
5770 c amino-acid residues.
5771 implicit real*8 (a-h,o-z)
5772 include 'DIMENSIONS'
5773 include 'COMMON.VAR'
5774 include 'COMMON.GEO'
5775 include 'COMMON.LOCAL'
5776 include 'COMMON.TORSION'
5777 include 'COMMON.SCCOR'
5778 include 'COMMON.INTERACT'
5779 include 'COMMON.DERIV'
5780 include 'COMMON.CHAIN'
5781 include 'COMMON.NAMES'
5782 include 'COMMON.IOUNITS'
5783 include 'COMMON.FFIELD'
5784 include 'COMMON.CONTROL'
5786 C Set lprn=.true. for debugging
5789 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5791 do i=itau_start,itau_end
5792 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5794 isccori=isccortyp(itype(i-2))
5795 isccori1=isccortyp(itype(i-1))
5796 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5798 do intertyp=1,3 !intertyp
5799 cc Added 09 May 2012 (Adasko)
5800 cc Intertyp means interaction type of backbone mainchain correlation:
5801 c 1 = SC...Ca...Ca...Ca
5802 c 2 = Ca...Ca...Ca...SC
5803 c 3 = SC...Ca...Ca...SCi
5805 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5806 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5807 & (itype(i-1).eq.ntyp1)))
5808 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5809 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5810 & .or.(itype(i).eq.ntyp1)))
5811 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5812 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5813 & (itype(i-3).eq.ntyp1)))) cycle
5814 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5815 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5817 do j=1,nterm_sccor(isccori,isccori1)
5818 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5819 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5820 cosphi=dcos(j*tauangle(intertyp,i))
5821 sinphi=dsin(j*tauangle(intertyp,i))
5822 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5823 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5825 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5826 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5828 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5829 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
5830 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
5831 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5832 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5838 c----------------------------------------------------------------------------
5839 subroutine multibody(ecorr)
5840 C This subroutine calculates multi-body contributions to energy following
5841 C the idea of Skolnick et al. If side chains I and J make a contact and
5842 C at the same time side chains I+1 and J+1 make a contact, an extra
5843 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5844 implicit real*8 (a-h,o-z)
5845 include 'DIMENSIONS'
5846 include 'COMMON.IOUNITS'
5847 include 'COMMON.DERIV'
5848 include 'COMMON.INTERACT'
5849 include 'COMMON.CONTACTS'
5850 double precision gx(3),gx1(3)
5853 C Set lprn=.true. for debugging
5857 write (iout,'(a)') 'Contact function values:'
5859 write (iout,'(i2,20(1x,i2,f10.5))')
5860 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5875 num_conti=num_cont(i)
5876 num_conti1=num_cont(i1)
5881 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5882 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5883 cd & ' ishift=',ishift
5884 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5885 C The system gains extra energy.
5886 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5887 endif ! j1==j+-ishift
5896 c------------------------------------------------------------------------------
5897 double precision function esccorr(i,j,k,l,jj,kk)
5898 implicit real*8 (a-h,o-z)
5899 include 'DIMENSIONS'
5900 include 'COMMON.IOUNITS'
5901 include 'COMMON.DERIV'
5902 include 'COMMON.INTERACT'
5903 include 'COMMON.CONTACTS'
5904 double precision gx(3),gx1(3)
5909 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5910 C Calculate the multi-body contribution to energy.
5911 C Calculate multi-body contributions to the gradient.
5912 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5913 cd & k,l,(gacont(m,kk,k),m=1,3)
5915 gx(m) =ekl*gacont(m,jj,i)
5916 gx1(m)=eij*gacont(m,kk,k)
5917 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5918 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5919 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5920 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5924 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5929 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5935 c------------------------------------------------------------------------------
5936 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5937 C This subroutine calculates multi-body contributions to hydrogen-bonding
5938 implicit real*8 (a-h,o-z)
5939 include 'DIMENSIONS'
5940 include 'COMMON.IOUNITS'
5943 parameter (max_cont=maxconts)
5944 parameter (max_dim=26)
5945 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5946 double precision zapas(max_dim,maxconts,max_fg_procs),
5947 & zapas_recv(max_dim,maxconts,max_fg_procs)
5948 common /przechowalnia/ zapas
5949 integer status(MPI_STATUS_SIZE),req(maxconts*2),
5950 & status_array(MPI_STATUS_SIZE,maxconts*2)
5952 include 'COMMON.SETUP'
5953 include 'COMMON.FFIELD'
5954 include 'COMMON.DERIV'
5955 include 'COMMON.INTERACT'
5956 include 'COMMON.CONTACTS'
5957 include 'COMMON.CONTROL'
5958 include 'COMMON.LOCAL'
5959 double precision gx(3),gx1(3),time00
5962 C Set lprn=.true. for debugging
5967 if (nfgtasks.le.1) goto 30
5969 write (iout,'(a)') 'Contact function values before RECEIVE:'
5971 write (iout,'(2i3,50(1x,i2,f5.2))')
5972 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5973 & j=1,num_cont_hb(i))
5977 do i=1,ntask_cont_from
5980 do i=1,ntask_cont_to
5983 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
5985 C Make the list of contacts to send to send to other procesors
5986 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
5988 do i=iturn3_start,iturn3_end
5989 c write (iout,*) "make contact list turn3",i," num_cont",
5991 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
5993 do i=iturn4_start,iturn4_end
5994 c write (iout,*) "make contact list turn4",i," num_cont",
5996 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6000 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6002 do j=1,num_cont_hb(i)
6005 iproc=iint_sent_local(k,jjc,ii)
6006 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6007 if (iproc.gt.0) then
6008 ncont_sent(iproc)=ncont_sent(iproc)+1
6009 nn=ncont_sent(iproc)
6011 zapas(2,nn,iproc)=jjc
6012 zapas(3,nn,iproc)=facont_hb(j,i)
6013 zapas(4,nn,iproc)=ees0p(j,i)
6014 zapas(5,nn,iproc)=ees0m(j,i)
6015 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6016 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6017 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6018 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6019 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6020 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6021 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6022 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6023 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6024 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6025 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6026 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6027 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6028 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6029 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6030 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6031 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6032 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6033 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6034 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6035 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6042 & "Numbers of contacts to be sent to other processors",
6043 & (ncont_sent(i),i=1,ntask_cont_to)
6044 write (iout,*) "Contacts sent"
6045 do ii=1,ntask_cont_to
6047 iproc=itask_cont_to(ii)
6048 write (iout,*) nn," contacts to processor",iproc,
6049 & " of CONT_TO_COMM group"
6051 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6059 CorrelID1=nfgtasks+fg_rank+1
6061 C Receive the numbers of needed contacts from other processors
6062 do ii=1,ntask_cont_from
6063 iproc=itask_cont_from(ii)
6065 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6066 & FG_COMM,req(ireq),IERR)
6068 c write (iout,*) "IRECV ended"
6070 C Send the number of contacts needed by other processors
6071 do ii=1,ntask_cont_to
6072 iproc=itask_cont_to(ii)
6074 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6075 & FG_COMM,req(ireq),IERR)
6077 c write (iout,*) "ISEND ended"
6078 c write (iout,*) "number of requests (nn)",ireq
6081 & call MPI_Waitall(ireq,req,status_array,ierr)
6083 c & "Numbers of contacts to be received from other processors",
6084 c & (ncont_recv(i),i=1,ntask_cont_from)
6088 do ii=1,ntask_cont_from
6089 iproc=itask_cont_from(ii)
6091 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6092 c & " of CONT_TO_COMM group"
6096 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6097 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6098 c write (iout,*) "ireq,req",ireq,req(ireq)
6101 C Send the contacts to processors that need them
6102 do ii=1,ntask_cont_to
6103 iproc=itask_cont_to(ii)
6105 c write (iout,*) nn," contacts to processor",iproc,
6106 c & " of CONT_TO_COMM group"
6109 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6110 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6111 c write (iout,*) "ireq,req",ireq,req(ireq)
6113 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6117 c write (iout,*) "number of requests (contacts)",ireq
6118 c write (iout,*) "req",(req(i),i=1,4)
6121 & call MPI_Waitall(ireq,req,status_array,ierr)
6122 do iii=1,ntask_cont_from
6123 iproc=itask_cont_from(iii)
6126 write (iout,*) "Received",nn," contacts from processor",iproc,
6127 & " of CONT_FROM_COMM group"
6130 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6135 ii=zapas_recv(1,i,iii)
6136 c Flag the received contacts to prevent double-counting
6137 jj=-zapas_recv(2,i,iii)
6138 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6140 nnn=num_cont_hb(ii)+1
6143 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6144 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6145 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6146 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6147 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6148 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6149 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6150 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6151 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6152 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6153 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6154 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6155 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6156 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6157 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6158 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6159 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6160 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6161 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6162 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6163 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6164 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6165 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6166 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6171 write (iout,'(a)') 'Contact function values after receive:'
6173 write (iout,'(2i3,50(1x,i3,f5.2))')
6174 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6175 & j=1,num_cont_hb(i))
6182 write (iout,'(a)') 'Contact function values:'
6184 write (iout,'(2i3,50(1x,i3,f5.2))')
6185 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6186 & j=1,num_cont_hb(i))
6190 C Remove the loop below after debugging !!!
6197 C Calculate the local-electrostatic correlation terms
6198 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6200 num_conti=num_cont_hb(i)
6201 num_conti1=num_cont_hb(i+1)
6208 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6209 c & ' jj=',jj,' kk=',kk
6210 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6211 & .or. j.lt.0 .and. j1.gt.0) .and.
6212 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6213 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6214 C The system gains extra energy.
6215 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6216 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6217 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6219 else if (j1.eq.j) then
6220 C Contacts I-J and I-(J+1) occur simultaneously.
6221 C The system loses extra energy.
6222 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6227 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6228 c & ' jj=',jj,' kk=',kk
6230 C Contacts I-J and (I+1)-J occur simultaneously.
6231 C The system loses extra energy.
6232 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6239 c------------------------------------------------------------------------------
6240 subroutine add_hb_contact(ii,jj,itask)
6241 implicit real*8 (a-h,o-z)
6242 include "DIMENSIONS"
6243 include "COMMON.IOUNITS"
6246 parameter (max_cont=maxconts)
6247 parameter (max_dim=26)
6248 include "COMMON.CONTACTS"
6249 double precision zapas(max_dim,maxconts,max_fg_procs),
6250 & zapas_recv(max_dim,maxconts,max_fg_procs)
6251 common /przechowalnia/ zapas
6252 integer i,j,ii,jj,iproc,itask(4),nn
6253 c write (iout,*) "itask",itask
6256 if (iproc.gt.0) then
6257 do j=1,num_cont_hb(ii)
6259 c write (iout,*) "i",ii," j",jj," jjc",jjc
6261 ncont_sent(iproc)=ncont_sent(iproc)+1
6262 nn=ncont_sent(iproc)
6263 zapas(1,nn,iproc)=ii
6264 zapas(2,nn,iproc)=jjc
6265 zapas(3,nn,iproc)=facont_hb(j,ii)
6266 zapas(4,nn,iproc)=ees0p(j,ii)
6267 zapas(5,nn,iproc)=ees0m(j,ii)
6268 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6269 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6270 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6271 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6272 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6273 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6274 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6275 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6276 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6277 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6278 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6279 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6280 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6281 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6282 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6283 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6284 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6285 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6286 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6287 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6288 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6296 c------------------------------------------------------------------------------
6297 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6299 C This subroutine calculates multi-body contributions to hydrogen-bonding
6300 implicit real*8 (a-h,o-z)
6301 include 'DIMENSIONS'
6302 include 'COMMON.IOUNITS'
6305 parameter (max_cont=maxconts)
6306 parameter (max_dim=70)
6307 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6308 double precision zapas(max_dim,maxconts,max_fg_procs),
6309 & zapas_recv(max_dim,maxconts,max_fg_procs)
6310 common /przechowalnia/ zapas
6311 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6312 & status_array(MPI_STATUS_SIZE,maxconts*2)
6314 include 'COMMON.SETUP'
6315 include 'COMMON.FFIELD'
6316 include 'COMMON.DERIV'
6317 include 'COMMON.LOCAL'
6318 include 'COMMON.INTERACT'
6319 include 'COMMON.CONTACTS'
6320 include 'COMMON.CHAIN'
6321 include 'COMMON.CONTROL'
6322 double precision gx(3),gx1(3)
6323 integer num_cont_hb_old(maxres)
6325 double precision eello4,eello5,eelo6,eello_turn6
6326 external eello4,eello5,eello6,eello_turn6
6327 C Set lprn=.true. for debugging
6332 num_cont_hb_old(i)=num_cont_hb(i)
6336 if (nfgtasks.le.1) goto 30
6338 write (iout,'(a)') 'Contact function values before RECEIVE:'
6340 write (iout,'(2i3,50(1x,i2,f5.2))')
6341 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6342 & j=1,num_cont_hb(i))
6346 do i=1,ntask_cont_from
6349 do i=1,ntask_cont_to
6352 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6354 C Make the list of contacts to send to send to other procesors
6355 do i=iturn3_start,iturn3_end
6356 c write (iout,*) "make contact list turn3",i," num_cont",
6358 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6360 do i=iturn4_start,iturn4_end
6361 c write (iout,*) "make contact list turn4",i," num_cont",
6363 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6367 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6369 do j=1,num_cont_hb(i)
6372 iproc=iint_sent_local(k,jjc,ii)
6373 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6374 if (iproc.ne.0) then
6375 ncont_sent(iproc)=ncont_sent(iproc)+1
6376 nn=ncont_sent(iproc)
6378 zapas(2,nn,iproc)=jjc
6379 zapas(3,nn,iproc)=d_cont(j,i)
6383 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6388 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6396 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6407 & "Numbers of contacts to be sent to other processors",
6408 & (ncont_sent(i),i=1,ntask_cont_to)
6409 write (iout,*) "Contacts sent"
6410 do ii=1,ntask_cont_to
6412 iproc=itask_cont_to(ii)
6413 write (iout,*) nn," contacts to processor",iproc,
6414 & " of CONT_TO_COMM group"
6416 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6424 CorrelID1=nfgtasks+fg_rank+1
6426 C Receive the numbers of needed contacts from other processors
6427 do ii=1,ntask_cont_from
6428 iproc=itask_cont_from(ii)
6430 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6431 & FG_COMM,req(ireq),IERR)
6433 c write (iout,*) "IRECV ended"
6435 C Send the number of contacts needed by other processors
6436 do ii=1,ntask_cont_to
6437 iproc=itask_cont_to(ii)
6439 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6440 & FG_COMM,req(ireq),IERR)
6442 c write (iout,*) "ISEND ended"
6443 c write (iout,*) "number of requests (nn)",ireq
6446 & call MPI_Waitall(ireq,req,status_array,ierr)
6448 c & "Numbers of contacts to be received from other processors",
6449 c & (ncont_recv(i),i=1,ntask_cont_from)
6453 do ii=1,ntask_cont_from
6454 iproc=itask_cont_from(ii)
6456 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6457 c & " of CONT_TO_COMM group"
6461 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6462 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6463 c write (iout,*) "ireq,req",ireq,req(ireq)
6466 C Send the contacts to processors that need them
6467 do ii=1,ntask_cont_to
6468 iproc=itask_cont_to(ii)
6470 c write (iout,*) nn," contacts to processor",iproc,
6471 c & " of CONT_TO_COMM group"
6474 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6475 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6476 c write (iout,*) "ireq,req",ireq,req(ireq)
6478 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6482 c write (iout,*) "number of requests (contacts)",ireq
6483 c write (iout,*) "req",(req(i),i=1,4)
6486 & call MPI_Waitall(ireq,req,status_array,ierr)
6487 do iii=1,ntask_cont_from
6488 iproc=itask_cont_from(iii)
6491 write (iout,*) "Received",nn," contacts from processor",iproc,
6492 & " of CONT_FROM_COMM group"
6495 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6500 ii=zapas_recv(1,i,iii)
6501 c Flag the received contacts to prevent double-counting
6502 jj=-zapas_recv(2,i,iii)
6503 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6505 nnn=num_cont_hb(ii)+1
6508 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6512 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6517 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6525 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6534 write (iout,'(a)') 'Contact function values after receive:'
6536 write (iout,'(2i3,50(1x,i3,5f6.3))')
6537 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6538 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6545 write (iout,'(a)') 'Contact function values:'
6547 write (iout,'(2i3,50(1x,i2,5f6.3))')
6548 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6549 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6555 C Remove the loop below after debugging !!!
6562 C Calculate the dipole-dipole interaction energies
6563 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6564 do i=iatel_s,iatel_e+1
6565 num_conti=num_cont_hb(i)
6574 C Calculate the local-electrostatic correlation terms
6575 c write (iout,*) "gradcorr5 in eello5 before loop"
6577 c write (iout,'(i5,3f10.5)')
6578 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6580 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6581 c write (iout,*) "corr loop i",i
6583 num_conti=num_cont_hb(i)
6584 num_conti1=num_cont_hb(i+1)
6591 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6592 c & ' jj=',jj,' kk=',kk
6593 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6594 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6595 & .or. j.lt.0 .and. j1.gt.0) .and.
6596 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6597 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6598 C The system gains extra energy.
6600 sqd1=dsqrt(d_cont(jj,i))
6601 sqd2=dsqrt(d_cont(kk,i1))
6602 sred_geom = sqd1*sqd2
6603 IF (sred_geom.lt.cutoff_corr) THEN
6604 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6606 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6607 cd & ' jj=',jj,' kk=',kk
6608 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6609 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6611 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6612 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6615 cd write (iout,*) 'sred_geom=',sred_geom,
6616 cd & ' ekont=',ekont,' fprim=',fprimcont,
6617 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6618 cd write (iout,*) "g_contij",g_contij
6619 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6620 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6621 call calc_eello(i,jp,i+1,jp1,jj,kk)
6622 if (wcorr4.gt.0.0d0)
6623 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6624 if (energy_dec.and.wcorr4.gt.0.0d0)
6625 1 write (iout,'(a6,4i5,0pf7.3)')
6626 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6627 c write (iout,*) "gradcorr5 before eello5"
6629 c write (iout,'(i5,3f10.5)')
6630 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6632 if (wcorr5.gt.0.0d0)
6633 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6634 c write (iout,*) "gradcorr5 after eello5"
6636 c write (iout,'(i5,3f10.5)')
6637 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6639 if (energy_dec.and.wcorr5.gt.0.0d0)
6640 1 write (iout,'(a6,4i5,0pf7.3)')
6641 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6642 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6643 cd write(2,*)'ijkl',i,jp,i+1,jp1
6644 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6645 & .or. wturn6.eq.0.0d0))then
6646 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6647 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6648 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6649 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6650 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6651 cd & 'ecorr6=',ecorr6
6652 cd write (iout,'(4e15.5)') sred_geom,
6653 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6654 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6655 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6656 else if (wturn6.gt.0.0d0
6657 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6658 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6659 eturn6=eturn6+eello_turn6(i,jj,kk)
6660 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6661 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6662 cd write (2,*) 'multibody_eello:eturn6',eturn6
6671 num_cont_hb(i)=num_cont_hb_old(i)
6673 c write (iout,*) "gradcorr5 in eello5"
6675 c write (iout,'(i5,3f10.5)')
6676 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6680 c------------------------------------------------------------------------------
6681 subroutine add_hb_contact_eello(ii,jj,itask)
6682 implicit real*8 (a-h,o-z)
6683 include "DIMENSIONS"
6684 include "COMMON.IOUNITS"
6687 parameter (max_cont=maxconts)
6688 parameter (max_dim=70)
6689 include "COMMON.CONTACTS"
6690 double precision zapas(max_dim,maxconts,max_fg_procs),
6691 & zapas_recv(max_dim,maxconts,max_fg_procs)
6692 common /przechowalnia/ zapas
6693 integer i,j,ii,jj,iproc,itask(4),nn
6694 c write (iout,*) "itask",itask
6697 if (iproc.gt.0) then
6698 do j=1,num_cont_hb(ii)
6700 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6702 ncont_sent(iproc)=ncont_sent(iproc)+1
6703 nn=ncont_sent(iproc)
6704 zapas(1,nn,iproc)=ii
6705 zapas(2,nn,iproc)=jjc
6706 zapas(3,nn,iproc)=d_cont(j,ii)
6710 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6715 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6723 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6735 c------------------------------------------------------------------------------
6736 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6737 implicit real*8 (a-h,o-z)
6738 include 'DIMENSIONS'
6739 include 'COMMON.IOUNITS'
6740 include 'COMMON.DERIV'
6741 include 'COMMON.INTERACT'
6742 include 'COMMON.CONTACTS'
6743 double precision gx(3),gx1(3)
6753 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6754 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6755 C Following 4 lines for diagnostics.
6760 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6761 c & 'Contacts ',i,j,
6762 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6763 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6765 C Calculate the multi-body contribution to energy.
6766 c ecorr=ecorr+ekont*ees
6767 C Calculate multi-body contributions to the gradient.
6768 coeffpees0pij=coeffp*ees0pij
6769 coeffmees0mij=coeffm*ees0mij
6770 coeffpees0pkl=coeffp*ees0pkl
6771 coeffmees0mkl=coeffm*ees0mkl
6773 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6774 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6775 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6776 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6777 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6778 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6779 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6780 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6781 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6782 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6783 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6784 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6785 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6786 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6787 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6788 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6789 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6790 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6791 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6792 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6793 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6794 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6795 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6796 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6797 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6802 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6803 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6804 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6805 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6810 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6811 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6812 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6813 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6816 c write (iout,*) "ehbcorr",ekont*ees
6821 C---------------------------------------------------------------------------
6822 subroutine dipole(i,j,jj)
6823 implicit real*8 (a-h,o-z)
6824 include 'DIMENSIONS'
6825 include 'COMMON.IOUNITS'
6826 include 'COMMON.CHAIN'
6827 include 'COMMON.FFIELD'
6828 include 'COMMON.DERIV'
6829 include 'COMMON.INTERACT'
6830 include 'COMMON.CONTACTS'
6831 include 'COMMON.TORSION'
6832 include 'COMMON.VAR'
6833 include 'COMMON.GEO'
6834 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6836 iti1 = itortyp(itype(i+1))
6837 if (j.lt.nres-1) then
6838 itj1 = itortyp(itype(j+1))
6843 dipi(iii,1)=Ub2(iii,i)
6844 dipderi(iii)=Ub2der(iii,i)
6845 dipi(iii,2)=b1(iii,iti1)
6846 dipj(iii,1)=Ub2(iii,j)
6847 dipderj(iii)=Ub2der(iii,j)
6848 dipj(iii,2)=b1(iii,itj1)
6852 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6855 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6862 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6866 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6871 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6872 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6874 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6876 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6878 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6883 C---------------------------------------------------------------------------
6884 subroutine calc_eello(i,j,k,l,jj,kk)
6886 C This subroutine computes matrices and vectors needed to calculate
6887 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6889 implicit real*8 (a-h,o-z)
6890 include 'DIMENSIONS'
6891 include 'COMMON.IOUNITS'
6892 include 'COMMON.CHAIN'
6893 include 'COMMON.DERIV'
6894 include 'COMMON.INTERACT'
6895 include 'COMMON.CONTACTS'
6896 include 'COMMON.TORSION'
6897 include 'COMMON.VAR'
6898 include 'COMMON.GEO'
6899 include 'COMMON.FFIELD'
6900 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6901 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6904 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6905 cd & ' jj=',jj,' kk=',kk
6906 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6907 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6908 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6911 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6912 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6915 call transpose2(aa1(1,1),aa1t(1,1))
6916 call transpose2(aa2(1,1),aa2t(1,1))
6919 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6920 & aa1tder(1,1,lll,kkk))
6921 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6922 & aa2tder(1,1,lll,kkk))
6926 C parallel orientation of the two CA-CA-CA frames.
6928 iti=itortyp(itype(i))
6932 itk1=itortyp(itype(k+1))
6933 itj=itortyp(itype(j))
6934 if (l.lt.nres-1) then
6935 itl1=itortyp(itype(l+1))
6939 C A1 kernel(j+1) A2T
6941 cd write (iout,'(3f10.5,5x,3f10.5)')
6942 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6944 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6945 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6946 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6947 C Following matrices are needed only for 6-th order cumulants
6948 IF (wcorr6.gt.0.0d0) THEN
6949 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6950 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6951 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6952 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6953 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6954 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6955 & ADtEAderx(1,1,1,1,1,1))
6957 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6958 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6959 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6960 & ADtEA1derx(1,1,1,1,1,1))
6962 C End 6-th order cumulants
6965 cd write (2,*) 'In calc_eello6'
6967 cd write (2,*) 'iii=',iii
6969 cd write (2,*) 'kkk=',kkk
6971 cd write (2,'(3(2f10.5),5x)')
6972 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6977 call transpose2(EUgder(1,1,k),auxmat(1,1))
6978 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6979 call transpose2(EUg(1,1,k),auxmat(1,1))
6980 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6981 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6985 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6986 & EAEAderx(1,1,lll,kkk,iii,1))
6990 C A1T kernel(i+1) A2
6991 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6992 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6993 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6994 C Following matrices are needed only for 6-th order cumulants
6995 IF (wcorr6.gt.0.0d0) THEN
6996 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6997 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6998 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6999 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7000 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7001 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7002 & ADtEAderx(1,1,1,1,1,2))
7003 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7004 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7005 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7006 & ADtEA1derx(1,1,1,1,1,2))
7008 C End 6-th order cumulants
7009 call transpose2(EUgder(1,1,l),auxmat(1,1))
7010 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7011 call transpose2(EUg(1,1,l),auxmat(1,1))
7012 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7013 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7017 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7018 & EAEAderx(1,1,lll,kkk,iii,2))
7023 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7024 C They are needed only when the fifth- or the sixth-order cumulants are
7026 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7027 call transpose2(AEA(1,1,1),auxmat(1,1))
7028 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7029 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7030 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7031 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7032 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7033 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7034 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7035 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7036 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7037 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7038 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7039 call transpose2(AEA(1,1,2),auxmat(1,1))
7040 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7041 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7042 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7043 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7044 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7045 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7046 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7047 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7048 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7049 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7050 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7051 C Calculate the Cartesian derivatives of the vectors.
7055 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7056 call matvec2(auxmat(1,1),b1(1,iti),
7057 & AEAb1derx(1,lll,kkk,iii,1,1))
7058 call matvec2(auxmat(1,1),Ub2(1,i),
7059 & AEAb2derx(1,lll,kkk,iii,1,1))
7060 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7061 & AEAb1derx(1,lll,kkk,iii,2,1))
7062 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7063 & AEAb2derx(1,lll,kkk,iii,2,1))
7064 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7065 call matvec2(auxmat(1,1),b1(1,itj),
7066 & AEAb1derx(1,lll,kkk,iii,1,2))
7067 call matvec2(auxmat(1,1),Ub2(1,j),
7068 & AEAb2derx(1,lll,kkk,iii,1,2))
7069 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7070 & AEAb1derx(1,lll,kkk,iii,2,2))
7071 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7072 & AEAb2derx(1,lll,kkk,iii,2,2))
7079 C Antiparallel orientation of the two CA-CA-CA frames.
7081 iti=itortyp(itype(i))
7085 itk1=itortyp(itype(k+1))
7086 itl=itortyp(itype(l))
7087 itj=itortyp(itype(j))
7088 if (j.lt.nres-1) then
7089 itj1=itortyp(itype(j+1))
7093 C A2 kernel(j-1)T A1T
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.,EUg(1,1,j),EUgder(1,1,j),
7096 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7097 C Following matrices are needed only for 6-th order cumulants
7098 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7099 & j.eq.i+4 .and. l.eq.i+3)) THEN
7100 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7101 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7102 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7103 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7104 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7105 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7106 & ADtEAderx(1,1,1,1,1,1))
7107 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7108 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7109 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7110 & ADtEA1derx(1,1,1,1,1,1))
7112 C End 6-th order cumulants
7113 call transpose2(EUgder(1,1,k),auxmat(1,1))
7114 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7115 call transpose2(EUg(1,1,k),auxmat(1,1))
7116 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7117 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7121 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7122 & EAEAderx(1,1,lll,kkk,iii,1))
7126 C A2T kernel(i+1)T A1
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.,EUg(1,1,k),EUgder(1,1,k),
7129 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7130 C Following matrices are needed only for 6-th order cumulants
7131 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7132 & j.eq.i+4 .and. l.eq.i+3)) THEN
7133 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7134 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7135 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7136 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7137 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7138 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7139 & ADtEAderx(1,1,1,1,1,2))
7140 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7141 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7142 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7143 & ADtEA1derx(1,1,1,1,1,2))
7145 C End 6-th order cumulants
7146 call transpose2(EUgder(1,1,j),auxmat(1,1))
7147 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7148 call transpose2(EUg(1,1,j),auxmat(1,1))
7149 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7150 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7154 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7155 & EAEAderx(1,1,lll,kkk,iii,2))
7160 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7161 C They are needed only when the fifth- or the sixth-order cumulants are
7163 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7164 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7165 call transpose2(AEA(1,1,1),auxmat(1,1))
7166 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7167 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7168 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7169 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7170 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7171 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7172 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7173 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7174 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7175 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7176 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7177 call transpose2(AEA(1,1,2),auxmat(1,1))
7178 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7179 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7180 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7181 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7182 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7183 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7184 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7185 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7186 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7187 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7188 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7189 C Calculate the Cartesian derivatives of the vectors.
7193 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7194 call matvec2(auxmat(1,1),b1(1,iti),
7195 & AEAb1derx(1,lll,kkk,iii,1,1))
7196 call matvec2(auxmat(1,1),Ub2(1,i),
7197 & AEAb2derx(1,lll,kkk,iii,1,1))
7198 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7199 & AEAb1derx(1,lll,kkk,iii,2,1))
7200 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7201 & AEAb2derx(1,lll,kkk,iii,2,1))
7202 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7203 call matvec2(auxmat(1,1),b1(1,itl),
7204 & AEAb1derx(1,lll,kkk,iii,1,2))
7205 call matvec2(auxmat(1,1),Ub2(1,l),
7206 & AEAb2derx(1,lll,kkk,iii,1,2))
7207 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7208 & AEAb1derx(1,lll,kkk,iii,2,2))
7209 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7210 & AEAb2derx(1,lll,kkk,iii,2,2))
7219 C---------------------------------------------------------------------------
7220 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7221 & KK,KKderg,AKA,AKAderg,AKAderx)
7225 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7226 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7227 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7232 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7234 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7237 cd if (lprn) write (2,*) 'In kernel'
7239 cd if (lprn) write (2,*) 'kkk=',kkk
7241 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7242 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7244 cd write (2,*) 'lll=',lll
7245 cd write (2,*) 'iii=1'
7247 cd write (2,'(3(2f10.5),5x)')
7248 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7251 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7252 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7254 cd write (2,*) 'lll=',lll
7255 cd write (2,*) 'iii=2'
7257 cd write (2,'(3(2f10.5),5x)')
7258 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7265 C---------------------------------------------------------------------------
7266 double precision function eello4(i,j,k,l,jj,kk)
7267 implicit real*8 (a-h,o-z)
7268 include 'DIMENSIONS'
7269 include 'COMMON.IOUNITS'
7270 include 'COMMON.CHAIN'
7271 include 'COMMON.DERIV'
7272 include 'COMMON.INTERACT'
7273 include 'COMMON.CONTACTS'
7274 include 'COMMON.TORSION'
7275 include 'COMMON.VAR'
7276 include 'COMMON.GEO'
7277 double precision pizda(2,2),ggg1(3),ggg2(3)
7278 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7282 cd print *,'eello4:',i,j,k,l,jj,kk
7283 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7284 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7285 cold eij=facont_hb(jj,i)
7286 cold ekl=facont_hb(kk,k)
7288 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7289 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7290 gcorr_loc(k-1)=gcorr_loc(k-1)
7291 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7293 gcorr_loc(l-1)=gcorr_loc(l-1)
7294 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7296 gcorr_loc(j-1)=gcorr_loc(j-1)
7297 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7302 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7303 & -EAEAderx(2,2,lll,kkk,iii,1)
7304 cd derx(lll,kkk,iii)=0.0d0
7308 cd gcorr_loc(l-1)=0.0d0
7309 cd gcorr_loc(j-1)=0.0d0
7310 cd gcorr_loc(k-1)=0.0d0
7312 cd write (iout,*)'Contacts have occurred for peptide groups',
7313 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7314 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7315 if (j.lt.nres-1) then
7322 if (l.lt.nres-1) then
7330 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7331 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7332 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7333 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7334 cgrad ghalf=0.5d0*ggg1(ll)
7335 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7336 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7337 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7338 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7339 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7340 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7341 cgrad ghalf=0.5d0*ggg2(ll)
7342 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7343 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7344 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7345 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7346 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7347 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7351 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7356 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7361 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7366 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7370 cd write (2,*) iii,gcorr_loc(iii)
7373 cd write (2,*) 'ekont',ekont
7374 cd write (iout,*) 'eello4',ekont*eel4
7377 C---------------------------------------------------------------------------
7378 double precision function eello5(i,j,k,l,jj,kk)
7379 implicit real*8 (a-h,o-z)
7380 include 'DIMENSIONS'
7381 include 'COMMON.IOUNITS'
7382 include 'COMMON.CHAIN'
7383 include 'COMMON.DERIV'
7384 include 'COMMON.INTERACT'
7385 include 'COMMON.CONTACTS'
7386 include 'COMMON.TORSION'
7387 include 'COMMON.VAR'
7388 include 'COMMON.GEO'
7389 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7390 double precision ggg1(3),ggg2(3)
7391 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7396 C /l\ / \ \ / \ / \ / C
7397 C / \ / \ \ / \ / \ / C
7398 C j| o |l1 | o | o| o | | o |o C
7399 C \ |/k\| |/ \| / |/ \| |/ \| C
7400 C \i/ \ / \ / / \ / \ C
7402 C (I) (II) (III) (IV) C
7404 C eello5_1 eello5_2 eello5_3 eello5_4 C
7406 C Antiparallel chains C
7409 C /j\ / \ \ / \ / \ / C
7410 C / \ / \ \ / \ / \ / C
7411 C j1| o |l | o | o| o | | o |o C
7412 C \ |/k\| |/ \| / |/ \| |/ \| C
7413 C \i/ \ / \ / / \ / \ C
7415 C (I) (II) (III) (IV) C
7417 C eello5_1 eello5_2 eello5_3 eello5_4 C
7419 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7421 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7422 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7427 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7429 itk=itortyp(itype(k))
7430 itl=itortyp(itype(l))
7431 itj=itortyp(itype(j))
7436 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7437 cd & eel5_3_num,eel5_4_num)
7441 derx(lll,kkk,iii)=0.0d0
7445 cd eij=facont_hb(jj,i)
7446 cd ekl=facont_hb(kk,k)
7448 cd write (iout,*)'Contacts have occurred for peptide groups',
7449 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7451 C Contribution from the graph I.
7452 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7453 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7454 call transpose2(EUg(1,1,k),auxmat(1,1))
7455 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7456 vv(1)=pizda(1,1)-pizda(2,2)
7457 vv(2)=pizda(1,2)+pizda(2,1)
7458 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7459 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7460 C Explicit gradient in virtual-dihedral angles.
7461 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7462 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7463 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7464 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7465 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7466 vv(1)=pizda(1,1)-pizda(2,2)
7467 vv(2)=pizda(1,2)+pizda(2,1)
7468 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7469 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7470 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7471 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7472 vv(1)=pizda(1,1)-pizda(2,2)
7473 vv(2)=pizda(1,2)+pizda(2,1)
7475 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7476 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7477 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7479 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7480 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7481 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7483 C Cartesian gradient
7487 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7489 vv(1)=pizda(1,1)-pizda(2,2)
7490 vv(2)=pizda(1,2)+pizda(2,1)
7491 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7492 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7493 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7499 C Contribution from graph II
7500 call transpose2(EE(1,1,itk),auxmat(1,1))
7501 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7502 vv(1)=pizda(1,1)+pizda(2,2)
7503 vv(2)=pizda(2,1)-pizda(1,2)
7504 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7505 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7506 C Explicit gradient in virtual-dihedral angles.
7507 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7508 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7509 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7510 vv(1)=pizda(1,1)+pizda(2,2)
7511 vv(2)=pizda(2,1)-pizda(1,2)
7513 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7514 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7515 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7517 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7518 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7519 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7521 C Cartesian gradient
7525 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7527 vv(1)=pizda(1,1)+pizda(2,2)
7528 vv(2)=pizda(2,1)-pizda(1,2)
7529 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7530 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7531 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7539 C Parallel orientation
7540 C Contribution from graph III
7541 call transpose2(EUg(1,1,l),auxmat(1,1))
7542 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7543 vv(1)=pizda(1,1)-pizda(2,2)
7544 vv(2)=pizda(1,2)+pizda(2,1)
7545 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7546 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7547 C Explicit gradient in virtual-dihedral angles.
7548 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7549 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7550 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7551 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7552 vv(1)=pizda(1,1)-pizda(2,2)
7553 vv(2)=pizda(1,2)+pizda(2,1)
7554 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7555 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7556 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7557 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7558 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7559 vv(1)=pizda(1,1)-pizda(2,2)
7560 vv(2)=pizda(1,2)+pizda(2,1)
7561 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7562 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7563 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7564 C Cartesian gradient
7568 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7570 vv(1)=pizda(1,1)-pizda(2,2)
7571 vv(2)=pizda(1,2)+pizda(2,1)
7572 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7573 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7574 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7579 C Contribution from graph IV
7581 call transpose2(EE(1,1,itl),auxmat(1,1))
7582 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7583 vv(1)=pizda(1,1)+pizda(2,2)
7584 vv(2)=pizda(2,1)-pizda(1,2)
7585 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7586 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7587 C Explicit gradient in virtual-dihedral angles.
7588 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7589 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7590 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7591 vv(1)=pizda(1,1)+pizda(2,2)
7592 vv(2)=pizda(2,1)-pizda(1,2)
7593 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7594 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7595 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7596 C Cartesian gradient
7600 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7602 vv(1)=pizda(1,1)+pizda(2,2)
7603 vv(2)=pizda(2,1)-pizda(1,2)
7604 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7605 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7606 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7611 C Antiparallel orientation
7612 C Contribution from graph III
7614 call transpose2(EUg(1,1,j),auxmat(1,1))
7615 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7616 vv(1)=pizda(1,1)-pizda(2,2)
7617 vv(2)=pizda(1,2)+pizda(2,1)
7618 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7619 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7620 C Explicit gradient in virtual-dihedral angles.
7621 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7622 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7623 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7624 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7625 vv(1)=pizda(1,1)-pizda(2,2)
7626 vv(2)=pizda(1,2)+pizda(2,1)
7627 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7628 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7629 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7630 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7631 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7632 vv(1)=pizda(1,1)-pizda(2,2)
7633 vv(2)=pizda(1,2)+pizda(2,1)
7634 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7635 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7636 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7637 C Cartesian gradient
7641 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7643 vv(1)=pizda(1,1)-pizda(2,2)
7644 vv(2)=pizda(1,2)+pizda(2,1)
7645 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7646 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7647 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7652 C Contribution from graph IV
7654 call transpose2(EE(1,1,itj),auxmat(1,1))
7655 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7656 vv(1)=pizda(1,1)+pizda(2,2)
7657 vv(2)=pizda(2,1)-pizda(1,2)
7658 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7659 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7660 C Explicit gradient in virtual-dihedral angles.
7661 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7662 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7663 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7664 vv(1)=pizda(1,1)+pizda(2,2)
7665 vv(2)=pizda(2,1)-pizda(1,2)
7666 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7667 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7668 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7669 C Cartesian gradient
7673 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7675 vv(1)=pizda(1,1)+pizda(2,2)
7676 vv(2)=pizda(2,1)-pizda(1,2)
7677 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7678 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7679 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7685 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7686 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7687 cd write (2,*) 'ijkl',i,j,k,l
7688 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7689 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7691 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7692 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7693 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7694 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7695 if (j.lt.nres-1) then
7702 if (l.lt.nres-1) then
7712 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7713 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7714 C summed up outside the subrouine as for the other subroutines
7715 C handling long-range interactions. The old code is commented out
7716 C with "cgrad" to keep track of changes.
7718 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7719 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7720 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7721 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7722 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7723 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7724 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7725 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7726 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7727 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7729 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7730 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7731 cgrad ghalf=0.5d0*ggg1(ll)
7733 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7734 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7735 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7736 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7737 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7738 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7739 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7740 cgrad ghalf=0.5d0*ggg2(ll)
7742 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7743 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7744 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7745 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7746 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7747 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7752 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7753 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7758 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7759 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7765 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7770 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7774 cd write (2,*) iii,g_corr5_loc(iii)
7777 cd write (2,*) 'ekont',ekont
7778 cd write (iout,*) 'eello5',ekont*eel5
7781 c--------------------------------------------------------------------------
7782 double precision function eello6(i,j,k,l,jj,kk)
7783 implicit real*8 (a-h,o-z)
7784 include 'DIMENSIONS'
7785 include 'COMMON.IOUNITS'
7786 include 'COMMON.CHAIN'
7787 include 'COMMON.DERIV'
7788 include 'COMMON.INTERACT'
7789 include 'COMMON.CONTACTS'
7790 include 'COMMON.TORSION'
7791 include 'COMMON.VAR'
7792 include 'COMMON.GEO'
7793 include 'COMMON.FFIELD'
7794 double precision ggg1(3),ggg2(3)
7795 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7800 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7808 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7809 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7813 derx(lll,kkk,iii)=0.0d0
7817 cd eij=facont_hb(jj,i)
7818 cd ekl=facont_hb(kk,k)
7824 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7825 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7826 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7827 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7828 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7829 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7831 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7832 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7833 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7834 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7835 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7836 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7840 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7842 C If turn contributions are considered, they will be handled separately.
7843 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7844 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7845 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7846 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7847 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7848 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7849 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7851 if (j.lt.nres-1) then
7858 if (l.lt.nres-1) then
7866 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7867 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7868 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7869 cgrad ghalf=0.5d0*ggg1(ll)
7871 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7872 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7873 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7874 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7875 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7876 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7877 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7878 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7879 cgrad ghalf=0.5d0*ggg2(ll)
7880 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7882 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7883 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7884 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7885 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7886 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7887 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7892 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7893 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7898 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7899 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7905 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7910 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7914 cd write (2,*) iii,g_corr6_loc(iii)
7917 cd write (2,*) 'ekont',ekont
7918 cd write (iout,*) 'eello6',ekont*eel6
7921 c--------------------------------------------------------------------------
7922 double precision function eello6_graph1(i,j,k,l,imat,swap)
7923 implicit real*8 (a-h,o-z)
7924 include 'DIMENSIONS'
7925 include 'COMMON.IOUNITS'
7926 include 'COMMON.CHAIN'
7927 include 'COMMON.DERIV'
7928 include 'COMMON.INTERACT'
7929 include 'COMMON.CONTACTS'
7930 include 'COMMON.TORSION'
7931 include 'COMMON.VAR'
7932 include 'COMMON.GEO'
7933 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7937 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7939 C Parallel Antiparallel C
7945 C \ j|/k\| / \ |/k\|l / C
7950 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7951 itk=itortyp(itype(k))
7952 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7953 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7954 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7955 call transpose2(EUgC(1,1,k),auxmat(1,1))
7956 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7957 vv1(1)=pizda1(1,1)-pizda1(2,2)
7958 vv1(2)=pizda1(1,2)+pizda1(2,1)
7959 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7960 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7961 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7962 s5=scalar2(vv(1),Dtobr2(1,i))
7963 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7964 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7965 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7966 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7967 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7968 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7969 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7970 & +scalar2(vv(1),Dtobr2der(1,i)))
7971 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7972 vv1(1)=pizda1(1,1)-pizda1(2,2)
7973 vv1(2)=pizda1(1,2)+pizda1(2,1)
7974 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7975 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7977 g_corr6_loc(l-1)=g_corr6_loc(l-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 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7984 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7985 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7986 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7987 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7989 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7990 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7991 vv1(1)=pizda1(1,1)-pizda1(2,2)
7992 vv1(2)=pizda1(1,2)+pizda1(2,1)
7993 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7994 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7995 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7996 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8005 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8006 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8007 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8008 call transpose2(EUgC(1,1,k),auxmat(1,1))
8009 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8011 vv1(1)=pizda1(1,1)-pizda1(2,2)
8012 vv1(2)=pizda1(1,2)+pizda1(2,1)
8013 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8014 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8015 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8016 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8017 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8018 s5=scalar2(vv(1),Dtobr2(1,i))
8019 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8025 c----------------------------------------------------------------------------
8026 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8027 implicit real*8 (a-h,o-z)
8028 include 'DIMENSIONS'
8029 include 'COMMON.IOUNITS'
8030 include 'COMMON.CHAIN'
8031 include 'COMMON.DERIV'
8032 include 'COMMON.INTERACT'
8033 include 'COMMON.CONTACTS'
8034 include 'COMMON.TORSION'
8035 include 'COMMON.VAR'
8036 include 'COMMON.GEO'
8038 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8039 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8042 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8044 C Parallel Antiparallel C
8050 C \ j|/k\| \ |/k\|l C
8055 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8056 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8057 C AL 7/4/01 s1 would occur in the sixth-order moment,
8058 C but not in a cluster cumulant
8060 s1=dip(1,jj,i)*dip(1,kk,k)
8062 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8063 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8064 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8065 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8066 call transpose2(EUg(1,1,k),auxmat(1,1))
8067 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8068 vv(1)=pizda(1,1)-pizda(2,2)
8069 vv(2)=pizda(1,2)+pizda(2,1)
8070 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8071 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8073 eello6_graph2=-(s1+s2+s3+s4)
8075 eello6_graph2=-(s2+s3+s4)
8078 C Derivatives in gamma(i-1)
8081 s1=dipderg(1,jj,i)*dip(1,kk,k)
8083 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8084 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8085 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8086 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8088 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8090 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8092 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8094 C Derivatives in gamma(k-1)
8096 s1=dip(1,jj,i)*dipderg(1,kk,k)
8098 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8099 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8100 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8101 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8102 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8103 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8104 vv(1)=pizda(1,1)-pizda(2,2)
8105 vv(2)=pizda(1,2)+pizda(2,1)
8106 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8108 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8110 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8112 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8113 C Derivatives in gamma(j-1) or gamma(l-1)
8116 s1=dipderg(3,jj,i)*dip(1,kk,k)
8118 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8119 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8120 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8121 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8122 vv(1)=pizda(1,1)-pizda(2,2)
8123 vv(2)=pizda(1,2)+pizda(2,1)
8124 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8127 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8129 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8132 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8133 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8135 C Derivatives in gamma(l-1) or gamma(j-1)
8138 s1=dip(1,jj,i)*dipderg(3,kk,k)
8140 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8141 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8142 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8143 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8144 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8145 vv(1)=pizda(1,1)-pizda(2,2)
8146 vv(2)=pizda(1,2)+pizda(2,1)
8147 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8150 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8152 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8155 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8156 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8158 C Cartesian derivatives.
8160 write (2,*) 'In eello6_graph2'
8162 write (2,*) 'iii=',iii
8164 write (2,*) 'kkk=',kkk
8166 write (2,'(3(2f10.5),5x)')
8167 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8177 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8179 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8182 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8184 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8185 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8187 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8188 call transpose2(EUg(1,1,k),auxmat(1,1))
8189 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8191 vv(1)=pizda(1,1)-pizda(2,2)
8192 vv(2)=pizda(1,2)+pizda(2,1)
8193 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8194 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8196 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8198 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8201 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8203 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8210 c----------------------------------------------------------------------------
8211 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8212 implicit real*8 (a-h,o-z)
8213 include 'DIMENSIONS'
8214 include 'COMMON.IOUNITS'
8215 include 'COMMON.CHAIN'
8216 include 'COMMON.DERIV'
8217 include 'COMMON.INTERACT'
8218 include 'COMMON.CONTACTS'
8219 include 'COMMON.TORSION'
8220 include 'COMMON.VAR'
8221 include 'COMMON.GEO'
8222 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8224 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8226 C Parallel Antiparallel C
8232 C j|/k\| / |/k\|l / C
8237 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8239 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8240 C energy moment and not to the cluster cumulant.
8241 iti=itortyp(itype(i))
8242 if (j.lt.nres-1) then
8243 itj1=itortyp(itype(j+1))
8247 itk=itortyp(itype(k))
8248 itk1=itortyp(itype(k+1))
8249 if (l.lt.nres-1) then
8250 itl1=itortyp(itype(l+1))
8255 s1=dip(4,jj,i)*dip(4,kk,k)
8257 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8258 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8259 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8260 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8261 call transpose2(EE(1,1,itk),auxmat(1,1))
8262 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8263 vv(1)=pizda(1,1)+pizda(2,2)
8264 vv(2)=pizda(2,1)-pizda(1,2)
8265 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8266 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8267 cd & "sum",-(s2+s3+s4)
8269 eello6_graph3=-(s1+s2+s3+s4)
8271 eello6_graph3=-(s2+s3+s4)
8274 C Derivatives in gamma(k-1)
8275 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8276 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8277 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8278 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8279 C Derivatives in gamma(l-1)
8280 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8281 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8282 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8283 vv(1)=pizda(1,1)+pizda(2,2)
8284 vv(2)=pizda(2,1)-pizda(1,2)
8285 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8286 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8287 C Cartesian derivatives.
8293 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8295 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8298 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8300 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8301 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8303 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8304 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8306 vv(1)=pizda(1,1)+pizda(2,2)
8307 vv(2)=pizda(2,1)-pizda(1,2)
8308 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8310 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8312 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8315 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8317 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8319 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8325 c----------------------------------------------------------------------------
8326 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8327 implicit real*8 (a-h,o-z)
8328 include 'DIMENSIONS'
8329 include 'COMMON.IOUNITS'
8330 include 'COMMON.CHAIN'
8331 include 'COMMON.DERIV'
8332 include 'COMMON.INTERACT'
8333 include 'COMMON.CONTACTS'
8334 include 'COMMON.TORSION'
8335 include 'COMMON.VAR'
8336 include 'COMMON.GEO'
8337 include 'COMMON.FFIELD'
8338 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8339 & auxvec1(2),auxmat1(2,2)
8341 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8343 C Parallel Antiparallel C
8349 C \ j|/k\| \ |/k\|l C
8354 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8356 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8357 C energy moment and not to the cluster cumulant.
8358 cd write (2,*) 'eello_graph4: wturn6',wturn6
8359 iti=itortyp(itype(i))
8360 itj=itortyp(itype(j))
8361 if (j.lt.nres-1) then
8362 itj1=itortyp(itype(j+1))
8366 itk=itortyp(itype(k))
8367 if (k.lt.nres-1) then
8368 itk1=itortyp(itype(k+1))
8372 itl=itortyp(itype(l))
8373 if (l.lt.nres-1) then
8374 itl1=itortyp(itype(l+1))
8378 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8379 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8380 cd & ' itl',itl,' itl1',itl1
8383 s1=dip(3,jj,i)*dip(3,kk,k)
8385 s1=dip(2,jj,j)*dip(2,kk,l)
8388 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8389 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8391 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8392 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8394 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8395 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8397 call transpose2(EUg(1,1,k),auxmat(1,1))
8398 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8399 vv(1)=pizda(1,1)-pizda(2,2)
8400 vv(2)=pizda(2,1)+pizda(1,2)
8401 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8402 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8404 eello6_graph4=-(s1+s2+s3+s4)
8406 eello6_graph4=-(s2+s3+s4)
8408 C Derivatives in gamma(i-1)
8412 s1=dipderg(2,jj,i)*dip(3,kk,k)
8414 s1=dipderg(4,jj,j)*dip(2,kk,l)
8417 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8419 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8420 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8422 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8423 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8425 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8426 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8427 cd write (2,*) 'turn6 derivatives'
8429 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8431 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8435 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8437 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8441 C Derivatives in gamma(k-1)
8444 s1=dip(3,jj,i)*dipderg(2,kk,k)
8446 s1=dip(2,jj,j)*dipderg(4,kk,l)
8449 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8450 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8452 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8453 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8455 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8456 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8458 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8459 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8460 vv(1)=pizda(1,1)-pizda(2,2)
8461 vv(2)=pizda(2,1)+pizda(1,2)
8462 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8463 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8465 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8467 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8471 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8473 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8476 C Derivatives in gamma(j-1) or gamma(l-1)
8477 if (l.eq.j+1 .and. l.gt.1) then
8478 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8479 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8480 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8481 vv(1)=pizda(1,1)-pizda(2,2)
8482 vv(2)=pizda(2,1)+pizda(1,2)
8483 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8484 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8485 else if (j.gt.1) then
8486 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8487 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8488 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8489 vv(1)=pizda(1,1)-pizda(2,2)
8490 vv(2)=pizda(2,1)+pizda(1,2)
8491 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8492 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8493 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8495 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8498 C Cartesian derivatives.
8505 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8507 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8511 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8513 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8517 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8519 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8521 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8522 & b1(1,itj1),auxvec(1))
8523 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8525 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8526 & b1(1,itl1),auxvec(1))
8527 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8529 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8531 vv(1)=pizda(1,1)-pizda(2,2)
8532 vv(2)=pizda(2,1)+pizda(1,2)
8533 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8535 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8537 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8540 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8543 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8546 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8548 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8550 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8554 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8556 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8559 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8561 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8569 c----------------------------------------------------------------------------
8570 double precision function eello_turn6(i,jj,kk)
8571 implicit real*8 (a-h,o-z)
8572 include 'DIMENSIONS'
8573 include 'COMMON.IOUNITS'
8574 include 'COMMON.CHAIN'
8575 include 'COMMON.DERIV'
8576 include 'COMMON.INTERACT'
8577 include 'COMMON.CONTACTS'
8578 include 'COMMON.TORSION'
8579 include 'COMMON.VAR'
8580 include 'COMMON.GEO'
8581 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8582 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8584 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8585 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8586 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8587 C the respective energy moment and not to the cluster cumulant.
8596 iti=itortyp(itype(i))
8597 itk=itortyp(itype(k))
8598 itk1=itortyp(itype(k+1))
8599 itl=itortyp(itype(l))
8600 itj=itortyp(itype(j))
8601 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8602 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8603 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8608 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8610 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8614 derx_turn(lll,kkk,iii)=0.0d0
8621 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8623 cd write (2,*) 'eello6_5',eello6_5
8625 call transpose2(AEA(1,1,1),auxmat(1,1))
8626 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8627 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8628 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8630 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8631 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8632 s2 = scalar2(b1(1,itk),vtemp1(1))
8634 call transpose2(AEA(1,1,2),atemp(1,1))
8635 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8636 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8637 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8639 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8640 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8641 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8643 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8644 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8645 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8646 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8647 ss13 = scalar2(b1(1,itk),vtemp4(1))
8648 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8650 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8656 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8657 C Derivatives in gamma(i+2)
8661 call transpose2(AEA(1,1,1),auxmatd(1,1))
8662 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8663 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8664 call transpose2(AEAderg(1,1,2),atempd(1,1))
8665 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8666 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8668 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8669 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8670 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8676 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8677 C Derivatives in gamma(i+3)
8679 call transpose2(AEA(1,1,1),auxmatd(1,1))
8680 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8681 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8682 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8684 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8685 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8686 s2d = scalar2(b1(1,itk),vtemp1d(1))
8688 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8689 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8691 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8693 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8694 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8695 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8703 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8704 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8706 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8707 & -0.5d0*ekont*(s2d+s12d)
8709 C Derivatives in gamma(i+4)
8710 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8711 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8712 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8714 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8715 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8716 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8724 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8726 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8728 C Derivatives in gamma(i+5)
8730 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8731 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8732 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8734 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8735 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8736 s2d = scalar2(b1(1,itk),vtemp1d(1))
8738 call transpose2(AEA(1,1,2),atempd(1,1))
8739 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8740 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8742 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8743 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8745 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8746 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8747 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8755 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8756 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8758 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8759 & -0.5d0*ekont*(s2d+s12d)
8761 C Cartesian derivatives
8766 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8767 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8768 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8770 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8771 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8773 s2d = scalar2(b1(1,itk),vtemp1d(1))
8775 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8776 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8777 s8d = -(atempd(1,1)+atempd(2,2))*
8778 & scalar2(cc(1,1,itl),vtemp2(1))
8780 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8782 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8783 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8790 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8793 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8797 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8798 & - 0.5d0*(s8d+s12d)
8800 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8809 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8811 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8812 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8813 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8814 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8815 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8817 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8818 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8819 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8823 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8824 cd & 16*eel_turn6_num
8826 if (j.lt.nres-1) then
8833 if (l.lt.nres-1) then
8841 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8842 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8843 cgrad ghalf=0.5d0*ggg1(ll)
8845 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8846 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8847 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8848 & +ekont*derx_turn(ll,2,1)
8849 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8850 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8851 & +ekont*derx_turn(ll,4,1)
8852 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8853 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8854 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8855 cgrad ghalf=0.5d0*ggg2(ll)
8857 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8858 & +ekont*derx_turn(ll,2,2)
8859 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8860 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8861 & +ekont*derx_turn(ll,4,2)
8862 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8863 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8864 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8869 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8874 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8880 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8885 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8889 cd write (2,*) iii,g_corr6_loc(iii)
8891 eello_turn6=ekont*eel_turn6
8892 cd write (2,*) 'ekont',ekont
8893 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8897 C-----------------------------------------------------------------------------
8898 double precision function scalar(u,v)
8899 !DIR$ INLINEALWAYS scalar
8901 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8904 double precision u(3),v(3)
8905 cd double precision sc
8913 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8916 crc-------------------------------------------------
8917 SUBROUTINE MATVEC2(A1,V1,V2)
8918 !DIR$ INLINEALWAYS MATVEC2
8920 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8922 implicit real*8 (a-h,o-z)
8923 include 'DIMENSIONS'
8924 DIMENSION A1(2,2),V1(2),V2(2)
8928 c 3 VI=VI+A1(I,K)*V1(K)
8932 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8933 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8938 C---------------------------------------
8939 SUBROUTINE MATMAT2(A1,A2,A3)
8941 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8943 implicit real*8 (a-h,o-z)
8944 include 'DIMENSIONS'
8945 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8946 c DIMENSION AI3(2,2)
8950 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8956 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8957 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8958 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8959 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8967 c-------------------------------------------------------------------------
8968 double precision function scalar2(u,v)
8969 !DIR$ INLINEALWAYS scalar2
8971 double precision u(2),v(2)
8974 scalar2=u(1)*v(1)+u(2)*v(2)
8978 C-----------------------------------------------------------------------------
8980 subroutine transpose2(a,at)
8981 !DIR$ INLINEALWAYS transpose2
8983 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8986 double precision a(2,2),at(2,2)
8993 c--------------------------------------------------------------------------
8994 subroutine transpose(n,a,at)
8997 double precision a(n,n),at(n,n)
9005 C---------------------------------------------------------------------------
9006 subroutine prodmat3(a1,a2,kk,transp,prod)
9007 !DIR$ INLINEALWAYS prodmat3
9009 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9013 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9015 crc double precision auxmat(2,2),prod_(2,2)
9018 crc call transpose2(kk(1,1),auxmat(1,1))
9019 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9020 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9022 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9023 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9024 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9025 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9026 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9027 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9028 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9029 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9032 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9033 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9035 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9036 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9037 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9038 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9039 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9040 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9041 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9042 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9045 c call transpose2(a2(1,1),a2t(1,1))
9048 crc print *,((prod_(i,j),i=1,2),j=1,2)
9049 crc print *,((prod(i,j),i=1,2),j=1,2)