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'
27 include 'COMMON.SPLITELE'
29 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
30 c & " nfgtasks",nfgtasks
31 if (nfgtasks.gt.1) then
33 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
34 if (fg_rank.eq.0) then
35 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
36 c print *,"Processor",myrank," BROADCAST iorder"
37 C FG master sets up the WEIGHTS_ array which will be broadcast to the
38 C FG slaves as WEIGHTS array.
58 C FG Master broadcasts the WEIGHTS_ array
59 call MPI_Bcast(weights_(1),n_ene,
60 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
62 C FG slaves receive the WEIGHTS array
63 call MPI_Bcast(weights(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
85 time_Bcast=time_Bcast+MPI_Wtime()-time00
86 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
87 c call chainbuild_cart
89 c print *,'Processor',myrank,' calling etotal ipot=',ipot
90 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
92 c if (modecalc.eq.12.or.modecalc.eq.14) then
93 c call int_from_cart1(.false.)
100 C Compute the side-chain and electrostatic interaction energy
102 goto (101,102,103,104,105,106) ipot
103 C Lennard-Jones potential.
105 cd print '(a)','Exit ELJ'
107 C Lennard-Jones-Kihara potential (shifted).
110 C Berne-Pechukas potential (dilated LJ, angular dependence).
113 C Gay-Berne potential (shifted LJ, angular dependence).
116 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
119 C Soft-sphere potential
120 106 call e_softsphere(evdw)
122 C Calculate electrostatic (H-bonding) energy of the main chain.
125 c print *,"Processor",myrank," computed USCSC"
131 time_vec=time_vec+MPI_Wtime()-time01
133 c print *,"Processor",myrank," left VEC_AND_DERIV"
136 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
137 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
138 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
139 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
141 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
142 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
143 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
144 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
146 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
155 c write (iout,*) "Soft-spheer ELEC potential"
156 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
159 c print *,"Processor",myrank," computed UELEC"
161 C Calculate excluded-volume interaction energy between peptide groups
166 call escp(evdw2,evdw2_14)
172 c write (iout,*) "Soft-sphere SCP potential"
173 call escp_soft_sphere(evdw2,evdw2_14)
176 c Calculate the bond-stretching energy
180 C Calculate the disulfide-bridge and other energy and the contributions
181 C from other distance constraints.
182 cd print *,'Calling EHPB'
184 cd print *,'EHPB exitted succesfully.'
186 C Calculate the virtual-bond-angle energy.
188 if (wang.gt.0d0) then
193 c print *,"Processor",myrank," computed UB"
195 C Calculate the SC local energy.
198 c print *,"Processor",myrank," computed USC"
200 C Calculate the virtual-bond torsional energy.
202 cd print *,'nterm=',nterm
204 call etor(etors,edihcnstr)
209 c print *,"Processor",myrank," computed Utor"
211 C 6/23/01 Calculate double-torsional energy
213 if (wtor_d.gt.0) then
218 c print *,"Processor",myrank," computed Utord"
220 C 21/5/07 Calculate local sicdechain correlation energy
222 if (wsccor.gt.0.0d0) then
223 call eback_sc_corr(esccor)
227 c print *,"Processor",myrank," computed Usccorr"
229 C 12/1/95 Multi-body terms
233 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
234 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
235 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
236 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
237 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
244 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
245 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
246 cd write (iout,*) "multibody_hb ecorr",ecorr
248 c print *,"Processor",myrank," computed Ucorr"
250 C If performing constraint dynamics, call the constraint energy
251 C after the equilibration time
252 if(usampl.and.totT.gt.eq_time) then
260 time_enecalc=time_enecalc+MPI_Wtime()-time00
262 c print *,"Processor",myrank," computed Uconstr"
271 energia(2)=evdw2-evdw2_14
288 energia(8)=eello_turn3
289 energia(9)=eello_turn4
296 energia(19)=edihcnstr
298 energia(20)=Uconst+Uconst_back
300 c Here are the energies showed per procesor if the are more processors
301 c per molecule then we sum it up in sum_energy subroutine
302 c print *," Processor",myrank," calls SUM_ENERGY"
303 call sum_energy(energia,.true.)
304 c print *," Processor",myrank," left SUM_ENERGY"
306 time_sumene=time_sumene+MPI_Wtime()-time00
310 c-------------------------------------------------------------------------------
311 subroutine sum_energy(energia,reduce)
312 implicit real*8 (a-h,o-z)
317 cMS$ATTRIBUTES C :: proc_proc
323 include 'COMMON.SETUP'
324 include 'COMMON.IOUNITS'
325 double precision energia(0:n_ene),enebuff(0:n_ene+1)
326 include 'COMMON.FFIELD'
327 include 'COMMON.DERIV'
328 include 'COMMON.INTERACT'
329 include 'COMMON.SBRIDGE'
330 include 'COMMON.CHAIN'
332 include 'COMMON.CONTROL'
333 include 'COMMON.TIME1'
336 if (nfgtasks.gt.1 .and. reduce) then
338 write (iout,*) "energies before REDUCE"
339 call enerprint(energia)
343 enebuff(i)=energia(i)
346 call MPI_Barrier(FG_COMM,IERR)
347 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
349 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
350 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
352 write (iout,*) "energies after REDUCE"
353 call enerprint(energia)
356 time_Reduce=time_Reduce+MPI_Wtime()-time00
358 if (fg_rank.eq.0) then
362 evdw2=energia(2)+energia(18)
378 eello_turn3=energia(8)
379 eello_turn4=energia(9)
386 edihcnstr=energia(19)
391 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
392 & +wang*ebe+wtor*etors+wscloc*escloc
393 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
394 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
395 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
396 & +wbond*estr+Uconst+wsccor*esccor
398 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
399 & +wang*ebe+wtor*etors+wscloc*escloc
400 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
401 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
402 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
403 & +wbond*estr+Uconst+wsccor*esccor
409 if (isnan(etot).ne.0) energia(0)=1.0d+99
411 if (isnan(etot)) energia(0)=1.0d+99
416 idumm=proc_proc(etot,i)
418 call proc_proc(etot,i)
420 if(i.eq.1)energia(0)=1.0d+99
427 c-------------------------------------------------------------------------------
428 subroutine sum_gradient
429 implicit real*8 (a-h,o-z)
434 cMS$ATTRIBUTES C :: proc_proc
439 double precision gradbufc(3,maxres),gradbufx(3,maxres),
440 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
442 include 'COMMON.SETUP'
443 include 'COMMON.IOUNITS'
444 include 'COMMON.FFIELD'
445 include 'COMMON.DERIV'
446 include 'COMMON.INTERACT'
447 include 'COMMON.SBRIDGE'
448 include 'COMMON.CHAIN'
450 include 'COMMON.CONTROL'
451 include 'COMMON.TIME1'
452 include 'COMMON.MAXGRAD'
453 include 'COMMON.SCCOR'
458 write (iout,*) "sum_gradient gvdwc, gvdwx"
460 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
461 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
466 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
467 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
468 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
471 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
472 C in virtual-bond-vector coordinates
475 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
477 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
478 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
480 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
482 c write (iout,'(i5,3f10.5,2x,f10.5)')
483 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
485 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
487 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
488 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
496 gradbufc(j,i)=wsc*gvdwc(j,i)+
497 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
498 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
499 & wel_loc*gel_loc_long(j,i)+
500 & wcorr*gradcorr_long(j,i)+
501 & wcorr5*gradcorr5_long(j,i)+
502 & wcorr6*gradcorr6_long(j,i)+
503 & wturn6*gcorr6_turn_long(j,i)+
510 gradbufc(j,i)=wsc*gvdwc(j,i)+
511 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
512 & welec*gelc_long(j,i)+
514 & wel_loc*gel_loc_long(j,i)+
515 & wcorr*gradcorr_long(j,i)+
516 & wcorr5*gradcorr5_long(j,i)+
517 & wcorr6*gradcorr6_long(j,i)+
518 & wturn6*gcorr6_turn_long(j,i)+
524 if (nfgtasks.gt.1) then
527 write (iout,*) "gradbufc before allreduce"
529 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
535 gradbufc_sum(j,i)=gradbufc(j,i)
538 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
539 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
540 c time_reduce=time_reduce+MPI_Wtime()-time00
542 c write (iout,*) "gradbufc_sum after allreduce"
544 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
549 c time_allreduce=time_allreduce+MPI_Wtime()-time00
557 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
558 write (iout,*) (i," jgrad_start",jgrad_start(i),
559 & " jgrad_end ",jgrad_end(i),
560 & i=igrad_start,igrad_end)
563 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
564 c do not parallelize this part.
566 c do i=igrad_start,igrad_end
567 c do j=jgrad_start(i),jgrad_end(i)
569 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
574 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
578 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
582 write (iout,*) "gradbufc after summing"
584 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
591 write (iout,*) "gradbufc"
593 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
599 gradbufc_sum(j,i)=gradbufc(j,i)
604 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
608 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
613 c gradbufc(k,i)=0.0d0
617 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
622 write (iout,*) "gradbufc after summing"
624 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
632 gradbufc(k,nres)=0.0d0
637 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
638 & wel_loc*gel_loc(j,i)+
639 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
640 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
641 & wel_loc*gel_loc_long(j,i)+
642 & wcorr*gradcorr_long(j,i)+
643 & wcorr5*gradcorr5_long(j,i)+
644 & wcorr6*gradcorr6_long(j,i)+
645 & wturn6*gcorr6_turn_long(j,i))+
647 & wcorr*gradcorr(j,i)+
648 & wturn3*gcorr3_turn(j,i)+
649 & wturn4*gcorr4_turn(j,i)+
650 & wcorr5*gradcorr5(j,i)+
651 & wcorr6*gradcorr6(j,i)+
652 & wturn6*gcorr6_turn(j,i)+
653 & wsccor*gsccorc(j,i)
654 & +wscloc*gscloc(j,i)
656 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
657 & wel_loc*gel_loc(j,i)+
658 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
659 & welec*gelc_long(j,i)
660 & wel_loc*gel_loc_long(j,i)+
661 & wcorr*gcorr_long(j,i)+
662 & wcorr5*gradcorr5_long(j,i)+
663 & wcorr6*gradcorr6_long(j,i)+
664 & wturn6*gcorr6_turn_long(j,i))+
666 & wcorr*gradcorr(j,i)+
667 & wturn3*gcorr3_turn(j,i)+
668 & wturn4*gcorr4_turn(j,i)+
669 & wcorr5*gradcorr5(j,i)+
670 & wcorr6*gradcorr6(j,i)+
671 & wturn6*gcorr6_turn(j,i)+
672 & wsccor*gsccorc(j,i)
673 & +wscloc*gscloc(j,i)
675 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
677 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
678 & wsccor*gsccorx(j,i)
679 & +wscloc*gsclocx(j,i)
683 write (iout,*) "gloc before adding corr"
685 write (iout,*) i,gloc(i,icg)
689 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
690 & +wcorr5*g_corr5_loc(i)
691 & +wcorr6*g_corr6_loc(i)
692 & +wturn4*gel_loc_turn4(i)
693 & +wturn3*gel_loc_turn3(i)
694 & +wturn6*gel_loc_turn6(i)
695 & +wel_loc*gel_loc_loc(i)
698 write (iout,*) "gloc after adding corr"
700 write (iout,*) i,gloc(i,icg)
704 if (nfgtasks.gt.1) then
707 gradbufc(j,i)=gradc(j,i,icg)
708 gradbufx(j,i)=gradx(j,i,icg)
712 glocbuf(i)=gloc(i,icg)
716 write (iout,*) "gloc_sc before reduce"
719 write (iout,*) i,j,gloc_sc(j,i,icg)
726 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
730 call MPI_Barrier(FG_COMM,IERR)
731 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
733 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
734 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
735 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
736 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
737 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
738 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
739 time_reduce=time_reduce+MPI_Wtime()-time00
740 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
741 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
742 time_reduce=time_reduce+MPI_Wtime()-time00
745 write (iout,*) "gloc_sc after reduce"
748 write (iout,*) i,j,gloc_sc(j,i,icg)
754 write (iout,*) "gloc after reduce"
756 write (iout,*) i,gloc(i,icg)
761 if (gnorm_check) then
763 c Compute the maximum elements of the gradient
773 gcorr3_turn_max=0.0d0
774 gcorr4_turn_max=0.0d0
777 gcorr6_turn_max=0.0d0
787 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
788 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
789 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
790 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
791 & gvdwc_scp_max=gvdwc_scp_norm
792 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
793 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
794 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
795 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
796 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
797 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
798 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
799 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
800 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
801 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
802 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
803 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
804 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
806 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
807 & gcorr3_turn_max=gcorr3_turn_norm
808 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
810 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
811 & gcorr4_turn_max=gcorr4_turn_norm
812 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
813 if (gradcorr5_norm.gt.gradcorr5_max)
814 & gradcorr5_max=gradcorr5_norm
815 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
816 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
817 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
819 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
820 & gcorr6_turn_max=gcorr6_turn_norm
821 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
822 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
823 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
824 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
825 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
826 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
827 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
828 if (gradx_scp_norm.gt.gradx_scp_max)
829 & gradx_scp_max=gradx_scp_norm
830 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
831 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
832 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
833 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
834 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
835 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
836 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
837 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
841 open(istat,file=statname,position="append")
843 open(istat,file=statname,access="append")
845 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
846 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
847 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
848 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
849 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
850 & gsccorx_max,gsclocx_max
852 if (gvdwc_max.gt.1.0d4) then
853 write (iout,*) "gvdwc gvdwx gradb gradbx"
855 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
856 & gradb(j,i),gradbx(j,i),j=1,3)
858 call pdbout(0.0d0,'cipiszcze',iout)
864 write (iout,*) "gradc gradx gloc"
866 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
867 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
871 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
875 c-------------------------------------------------------------------------------
876 subroutine rescale_weights(t_bath)
877 implicit real*8 (a-h,o-z)
879 include 'COMMON.IOUNITS'
880 include 'COMMON.FFIELD'
881 include 'COMMON.SBRIDGE'
882 double precision kfac /2.4d0/
883 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
885 c facT=2*temp0/(t_bath+temp0)
886 if (rescale_mode.eq.0) then
892 else if (rescale_mode.eq.1) then
893 facT=kfac/(kfac-1.0d0+t_bath/temp0)
894 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
895 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
896 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
897 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
898 else if (rescale_mode.eq.2) then
904 facT=licznik/dlog(dexp(x)+dexp(-x))
905 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
906 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
907 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
908 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
910 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
911 write (*,*) "Wrong RESCALE_MODE",rescale_mode
913 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
917 welec=weights(3)*fact
918 wcorr=weights(4)*fact3
919 wcorr5=weights(5)*fact4
920 wcorr6=weights(6)*fact5
921 wel_loc=weights(7)*fact2
922 wturn3=weights(8)*fact2
923 wturn4=weights(9)*fact3
924 wturn6=weights(10)*fact5
925 wtor=weights(13)*fact
926 wtor_d=weights(14)*fact2
927 wsccor=weights(21)*fact
931 C------------------------------------------------------------------------
932 subroutine enerprint(energia)
933 implicit real*8 (a-h,o-z)
935 include 'COMMON.IOUNITS'
936 include 'COMMON.FFIELD'
937 include 'COMMON.SBRIDGE'
939 double precision energia(0:n_ene)
944 evdw2=energia(2)+energia(18)
956 eello_turn3=energia(8)
957 eello_turn4=energia(9)
958 eello_turn6=energia(10)
964 edihcnstr=energia(19)
969 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
970 & estr,wbond,ebe,wang,
971 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
973 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
974 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
977 10 format (/'Virtual-chain energies:'//
978 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
979 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
980 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
981 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
982 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
983 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
984 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
985 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
986 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
987 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
988 & ' (SS bridges & dist. cnstr.)'/
989 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
990 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
991 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
992 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
993 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
994 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
995 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
996 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
997 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
998 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
999 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1000 & 'ETOT= ',1pE16.6,' (total)')
1002 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1003 & estr,wbond,ebe,wang,
1004 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1006 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1007 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1008 & ebr*nss,Uconst,etot
1009 10 format (/'Virtual-chain energies:'//
1010 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1011 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1012 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1013 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1014 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1015 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1016 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1017 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1018 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1019 & ' (SS bridges & dist. cnstr.)'/
1020 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1021 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1022 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1023 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1024 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1025 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1026 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1027 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1028 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1029 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1030 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1031 & 'ETOT= ',1pE16.6,' (total)')
1035 C-----------------------------------------------------------------------
1036 subroutine elj(evdw)
1038 C This subroutine calculates the interaction energy of nonbonded side chains
1039 C assuming the LJ potential of interaction.
1041 implicit real*8 (a-h,o-z)
1042 include 'DIMENSIONS'
1043 parameter (accur=1.0d-10)
1044 include 'COMMON.GEO'
1045 include 'COMMON.VAR'
1046 include 'COMMON.LOCAL'
1047 include 'COMMON.CHAIN'
1048 include 'COMMON.DERIV'
1049 include 'COMMON.INTERACT'
1050 include 'COMMON.TORSION'
1051 include 'COMMON.SBRIDGE'
1052 include 'COMMON.NAMES'
1053 include 'COMMON.IOUNITS'
1054 include 'COMMON.CONTACTS'
1056 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1058 do i=iatsc_s,iatsc_e
1059 itypi=iabs(itype(i))
1060 if (itypi.eq.ntyp1) cycle
1061 itypi1=iabs(itype(i+1))
1068 C Calculate SC interaction energy.
1070 do iint=1,nint_gr(i)
1071 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1072 cd & 'iend=',iend(i,iint)
1073 do j=istart(i,iint),iend(i,iint)
1074 itypj=iabs(itype(j))
1075 if (itypj.eq.ntyp1) cycle
1079 C Change 12/1/95 to calculate four-body interactions
1080 rij=xj*xj+yj*yj+zj*zj
1082 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1083 eps0ij=eps(itypi,itypj)
1085 e1=fac*fac*aa(itypi,itypj)
1086 e2=fac*bb(itypi,itypj)
1088 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1089 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1090 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1091 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1092 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1093 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1096 C Calculate the components of the gradient in DC and X
1098 fac=-rrij*(e1+evdwij)
1103 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1104 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1105 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1106 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1110 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1114 C 12/1/95, revised on 5/20/97
1116 C Calculate the contact function. The ith column of the array JCONT will
1117 C contain the numbers of atoms that make contacts with the atom I (of numbers
1118 C greater than I). The arrays FACONT and GACONT will contain the values of
1119 C the contact function and its derivative.
1121 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1122 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1123 C Uncomment next line, if the correlation interactions are contact function only
1124 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1126 sigij=sigma(itypi,itypj)
1127 r0ij=rs0(itypi,itypj)
1129 C Check whether the SC's are not too far to make a contact.
1132 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1133 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1135 if (fcont.gt.0.0D0) then
1136 C If the SC-SC distance if close to sigma, apply spline.
1137 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1138 cAdam & fcont1,fprimcont1)
1139 cAdam fcont1=1.0d0-fcont1
1140 cAdam if (fcont1.gt.0.0d0) then
1141 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1142 cAdam fcont=fcont*fcont1
1144 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1145 cga eps0ij=1.0d0/dsqrt(eps0ij)
1147 cga gg(k)=gg(k)*eps0ij
1149 cga eps0ij=-evdwij*eps0ij
1150 C Uncomment for AL's type of SC correlation interactions.
1151 cadam eps0ij=-evdwij
1152 num_conti=num_conti+1
1153 jcont(num_conti,i)=j
1154 facont(num_conti,i)=fcont*eps0ij
1155 fprimcont=eps0ij*fprimcont/rij
1157 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1158 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1159 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1160 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1161 gacont(1,num_conti,i)=-fprimcont*xj
1162 gacont(2,num_conti,i)=-fprimcont*yj
1163 gacont(3,num_conti,i)=-fprimcont*zj
1164 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1165 cd write (iout,'(2i3,3f10.5)')
1166 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1172 num_cont(i)=num_conti
1176 gvdwc(j,i)=expon*gvdwc(j,i)
1177 gvdwx(j,i)=expon*gvdwx(j,i)
1180 C******************************************************************************
1184 C To save time, the factor of EXPON has been extracted from ALL components
1185 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1188 C******************************************************************************
1191 C-----------------------------------------------------------------------------
1192 subroutine eljk(evdw)
1194 C This subroutine calculates the interaction energy of nonbonded side chains
1195 C assuming the LJK potential of interaction.
1197 implicit real*8 (a-h,o-z)
1198 include 'DIMENSIONS'
1199 include 'COMMON.GEO'
1200 include 'COMMON.VAR'
1201 include 'COMMON.LOCAL'
1202 include 'COMMON.CHAIN'
1203 include 'COMMON.DERIV'
1204 include 'COMMON.INTERACT'
1205 include 'COMMON.IOUNITS'
1206 include 'COMMON.NAMES'
1209 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1211 do i=iatsc_s,iatsc_e
1212 itypi=iabs(itype(i))
1213 if (itypi.eq.ntyp1) cycle
1214 itypi1=iabs(itype(i+1))
1219 C Calculate SC interaction energy.
1221 do iint=1,nint_gr(i)
1222 do j=istart(i,iint),iend(i,iint)
1223 itypj=iabs(itype(j))
1224 if (itypj.eq.ntyp1) cycle
1228 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1229 fac_augm=rrij**expon
1230 e_augm=augm(itypi,itypj)*fac_augm
1231 r_inv_ij=dsqrt(rrij)
1233 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1234 fac=r_shift_inv**expon
1235 e1=fac*fac*aa(itypi,itypj)
1236 e2=fac*bb(itypi,itypj)
1238 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1239 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1240 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1241 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1242 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1243 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1244 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1247 C Calculate the components of the gradient in DC and X
1249 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1254 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1255 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1256 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1257 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1261 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1269 gvdwc(j,i)=expon*gvdwc(j,i)
1270 gvdwx(j,i)=expon*gvdwx(j,i)
1275 C-----------------------------------------------------------------------------
1276 subroutine ebp(evdw)
1278 C This subroutine calculates the interaction energy of nonbonded side chains
1279 C assuming the Berne-Pechukas potential of interaction.
1281 implicit real*8 (a-h,o-z)
1282 include 'DIMENSIONS'
1283 include 'COMMON.GEO'
1284 include 'COMMON.VAR'
1285 include 'COMMON.LOCAL'
1286 include 'COMMON.CHAIN'
1287 include 'COMMON.DERIV'
1288 include 'COMMON.NAMES'
1289 include 'COMMON.INTERACT'
1290 include 'COMMON.IOUNITS'
1291 include 'COMMON.CALC'
1292 common /srutu/ icall
1293 c double precision rrsave(maxdim)
1296 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1298 c if (icall.eq.0) then
1304 do i=iatsc_s,iatsc_e
1305 itypi=iabs(itype(i))
1306 if (itypi.eq.ntyp1) cycle
1307 itypi1=iabs(itype(i+1))
1311 dxi=dc_norm(1,nres+i)
1312 dyi=dc_norm(2,nres+i)
1313 dzi=dc_norm(3,nres+i)
1314 c dsci_inv=dsc_inv(itypi)
1315 dsci_inv=vbld_inv(i+nres)
1317 C Calculate SC interaction energy.
1319 do iint=1,nint_gr(i)
1320 do j=istart(i,iint),iend(i,iint)
1322 itypj=iabs(itype(j))
1323 if (itypj.eq.ntyp1) cycle
1324 c dscj_inv=dsc_inv(itypj)
1325 dscj_inv=vbld_inv(j+nres)
1326 chi1=chi(itypi,itypj)
1327 chi2=chi(itypj,itypi)
1334 alf12=0.5D0*(alf1+alf2)
1335 C For diagnostics only!!!
1348 dxj=dc_norm(1,nres+j)
1349 dyj=dc_norm(2,nres+j)
1350 dzj=dc_norm(3,nres+j)
1351 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1352 cd if (icall.eq.0) then
1358 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1360 C Calculate whole angle-dependent part of epsilon and contributions
1361 C to its derivatives
1362 fac=(rrij*sigsq)**expon2
1363 e1=fac*fac*aa(itypi,itypj)
1364 e2=fac*bb(itypi,itypj)
1365 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1366 eps2der=evdwij*eps3rt
1367 eps3der=evdwij*eps2rt
1368 evdwij=evdwij*eps2rt*eps3rt
1371 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1372 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1373 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1374 cd & restyp(itypi),i,restyp(itypj),j,
1375 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1376 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1377 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1380 C Calculate gradient components.
1381 e1=e1*eps1*eps2rt**2*eps3rt**2
1382 fac=-expon*(e1+evdwij)
1385 C Calculate radial part of the gradient
1389 C Calculate the angular part of the gradient and sum add the contributions
1390 C to the appropriate components of the Cartesian gradient.
1398 C-----------------------------------------------------------------------------
1399 subroutine egb(evdw)
1401 C This subroutine calculates the interaction energy of nonbonded side chains
1402 C assuming the Gay-Berne potential of interaction.
1404 implicit real*8 (a-h,o-z)
1405 include 'DIMENSIONS'
1406 include 'COMMON.GEO'
1407 include 'COMMON.VAR'
1408 include 'COMMON.LOCAL'
1409 include 'COMMON.CHAIN'
1410 include 'COMMON.DERIV'
1411 include 'COMMON.NAMES'
1412 include 'COMMON.INTERACT'
1413 include 'COMMON.IOUNITS'
1414 include 'COMMON.CALC'
1415 include 'COMMON.CONTROL'
1416 include 'COMMON.SPLITELE'
1418 integer xshift,yshift,zshift
1420 ccccc energy_dec=.false.
1421 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1424 c if (icall.eq.0) lprn=.false.
1426 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1427 C we have the original box)
1431 do i=iatsc_s,iatsc_e
1432 itypi=iabs(itype(i))
1433 if (itypi.eq.ntyp1) cycle
1434 itypi1=iabs(itype(i+1))
1438 C Return atom into box, boxxsize is size of box in x dimension
1440 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1441 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1442 C Condition for being inside the proper box
1443 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1444 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1448 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1449 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1450 C Condition for being inside the proper box
1451 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1452 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1456 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1457 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1458 C Condition for being inside the proper box
1459 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1460 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1464 if (xi.lt.0) xi=xi+boxxsize
1466 if (yi.lt.0) yi=yi+boxysize
1468 if (zi.lt.0) zi=zi+boxzsize
1470 dxi=dc_norm(1,nres+i)
1471 dyi=dc_norm(2,nres+i)
1472 dzi=dc_norm(3,nres+i)
1473 c dsci_inv=dsc_inv(itypi)
1474 dsci_inv=vbld_inv(i+nres)
1475 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1476 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1478 C Calculate SC interaction energy.
1480 do iint=1,nint_gr(i)
1481 do j=istart(i,iint),iend(i,iint)
1483 itypj=iabs(itype(j))
1484 if (itypj.eq.ntyp1) cycle
1485 c dscj_inv=dsc_inv(itypj)
1486 dscj_inv=vbld_inv(j+nres)
1487 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1488 c & 1.0d0/vbld(j+nres)
1489 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1490 sig0ij=sigma(itypi,itypj)
1491 chi1=chi(itypi,itypj)
1492 chi2=chi(itypj,itypi)
1499 alf12=0.5D0*(alf1+alf2)
1500 C For diagnostics only!!!
1513 C Return atom J into box the original box
1515 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1516 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1517 C Condition for being inside the proper box
1518 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1519 c & (xj.lt.((-0.5d0)*boxxsize))) then
1523 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1524 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1525 C Condition for being inside the proper box
1526 c if ((yj.gt.((0.5d0)*boxysize)).or.
1527 c & (yj.lt.((-0.5d0)*boxysize))) then
1531 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1532 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1533 C Condition for being inside the proper box
1534 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1535 c & (zj.lt.((-0.5d0)*boxzsize))) then
1539 if (xj.lt.0) xj=xj+boxxsize
1541 if (yj.lt.0) yj=yj+boxysize
1543 if (zj.lt.0) zj=zj+boxzsize
1544 dxj=dc_norm(1,nres+j)
1545 dyj=dc_norm(2,nres+j)
1546 dzj=dc_norm(3,nres+j)
1550 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1551 c write (iout,*) "j",j," dc_norm",
1552 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1553 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1555 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1556 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1558 c write (iout,'(a7,4f8.3)')
1559 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1560 if (sss.gt.0.0d0) then
1561 C Calculate angle-dependent terms of energy and contributions to their
1565 sig=sig0ij*dsqrt(sigsq)
1566 rij_shift=1.0D0/rij-sig+sig0ij
1567 c for diagnostics; uncomment
1568 c rij_shift=1.2*sig0ij
1569 C I hate to put IF's in the loops, but here don't have another choice!!!!
1570 if (rij_shift.le.0.0D0) then
1572 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1573 cd & restyp(itypi),i,restyp(itypj),j,
1574 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1578 c---------------------------------------------------------------
1579 rij_shift=1.0D0/rij_shift
1580 fac=rij_shift**expon
1581 e1=fac*fac*aa(itypi,itypj)
1582 e2=fac*bb(itypi,itypj)
1583 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1584 eps2der=evdwij*eps3rt
1585 eps3der=evdwij*eps2rt
1586 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1587 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1588 evdwij=evdwij*eps2rt*eps3rt
1589 evdw=evdw+evdwij*sss
1591 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1592 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1593 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1594 & restyp(itypi),i,restyp(itypj),j,
1595 & epsi,sigm,chi1,chi2,chip1,chip2,
1596 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1597 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1601 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1604 C Calculate gradient components.
1605 e1=e1*eps1*eps2rt**2*eps3rt**2
1606 fac=-expon*(e1+evdwij)*rij_shift
1609 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1610 c & evdwij,fac,sigma(itypi,itypj),expon
1611 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1613 C Calculate the radial part of the gradient
1617 C Calculate angular part of the gradient.
1626 c write (iout,*) "Number of loop steps in EGB:",ind
1627 cccc energy_dec=.false.
1630 C-----------------------------------------------------------------------------
1631 subroutine egbv(evdw)
1633 C This subroutine calculates the interaction energy of nonbonded side chains
1634 C assuming the Gay-Berne-Vorobjev potential of interaction.
1636 implicit real*8 (a-h,o-z)
1637 include 'DIMENSIONS'
1638 include 'COMMON.GEO'
1639 include 'COMMON.VAR'
1640 include 'COMMON.LOCAL'
1641 include 'COMMON.CHAIN'
1642 include 'COMMON.DERIV'
1643 include 'COMMON.NAMES'
1644 include 'COMMON.INTERACT'
1645 include 'COMMON.IOUNITS'
1646 include 'COMMON.CALC'
1647 common /srutu/ icall
1650 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1653 c if (icall.eq.0) lprn=.true.
1655 do i=iatsc_s,iatsc_e
1656 itypi=iabs(itype(i))
1657 if (itypi.eq.ntyp1) cycle
1658 itypi1=iabs(itype(i+1))
1662 dxi=dc_norm(1,nres+i)
1663 dyi=dc_norm(2,nres+i)
1664 dzi=dc_norm(3,nres+i)
1665 c dsci_inv=dsc_inv(itypi)
1666 dsci_inv=vbld_inv(i+nres)
1668 C Calculate SC interaction energy.
1670 do iint=1,nint_gr(i)
1671 do j=istart(i,iint),iend(i,iint)
1673 itypj=iabs(itype(j))
1674 if (itypj.eq.ntyp1) cycle
1675 c dscj_inv=dsc_inv(itypj)
1676 dscj_inv=vbld_inv(j+nres)
1677 sig0ij=sigma(itypi,itypj)
1678 r0ij=r0(itypi,itypj)
1679 chi1=chi(itypi,itypj)
1680 chi2=chi(itypj,itypi)
1687 alf12=0.5D0*(alf1+alf2)
1688 C For diagnostics only!!!
1701 dxj=dc_norm(1,nres+j)
1702 dyj=dc_norm(2,nres+j)
1703 dzj=dc_norm(3,nres+j)
1704 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1706 C Calculate angle-dependent terms of energy and contributions to their
1710 sig=sig0ij*dsqrt(sigsq)
1711 rij_shift=1.0D0/rij-sig+r0ij
1712 C I hate to put IF's in the loops, but here don't have another choice!!!!
1713 if (rij_shift.le.0.0D0) then
1718 c---------------------------------------------------------------
1719 rij_shift=1.0D0/rij_shift
1720 fac=rij_shift**expon
1721 e1=fac*fac*aa(itypi,itypj)
1722 e2=fac*bb(itypi,itypj)
1723 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1724 eps2der=evdwij*eps3rt
1725 eps3der=evdwij*eps2rt
1726 fac_augm=rrij**expon
1727 e_augm=augm(itypi,itypj)*fac_augm
1728 evdwij=evdwij*eps2rt*eps3rt
1729 evdw=evdw+evdwij+e_augm
1731 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1732 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1733 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1734 & restyp(itypi),i,restyp(itypj),j,
1735 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1736 & chi1,chi2,chip1,chip2,
1737 & eps1,eps2rt**2,eps3rt**2,
1738 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1741 C Calculate gradient components.
1742 e1=e1*eps1*eps2rt**2*eps3rt**2
1743 fac=-expon*(e1+evdwij)*rij_shift
1745 fac=rij*fac-2*expon*rrij*e_augm
1746 C Calculate the radial part of the gradient
1750 C Calculate angular part of the gradient.
1756 C-----------------------------------------------------------------------------
1757 subroutine sc_angular
1758 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1759 C om12. Called by ebp, egb, and egbv.
1761 include 'COMMON.CALC'
1762 include 'COMMON.IOUNITS'
1766 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1767 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1768 om12=dxi*dxj+dyi*dyj+dzi*dzj
1770 C Calculate eps1(om12) and its derivative in om12
1771 faceps1=1.0D0-om12*chiom12
1772 faceps1_inv=1.0D0/faceps1
1773 eps1=dsqrt(faceps1_inv)
1774 C Following variable is eps1*deps1/dom12
1775 eps1_om12=faceps1_inv*chiom12
1780 c write (iout,*) "om12",om12," eps1",eps1
1781 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1786 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1787 sigsq=1.0D0-facsig*faceps1_inv
1788 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1789 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1790 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1796 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1797 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1799 C Calculate eps2 and its derivatives in om1, om2, and om12.
1802 chipom12=chip12*om12
1803 facp=1.0D0-om12*chipom12
1805 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1806 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1807 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1808 C Following variable is the square root of eps2
1809 eps2rt=1.0D0-facp1*facp_inv
1810 C Following three variables are the derivatives of the square root of eps
1811 C in om1, om2, and om12.
1812 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1813 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1814 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1815 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1816 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1817 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1818 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1819 c & " eps2rt_om12",eps2rt_om12
1820 C Calculate whole angle-dependent part of epsilon and contributions
1821 C to its derivatives
1824 C----------------------------------------------------------------------------
1826 implicit real*8 (a-h,o-z)
1827 include 'DIMENSIONS'
1828 include 'COMMON.CHAIN'
1829 include 'COMMON.DERIV'
1830 include 'COMMON.CALC'
1831 include 'COMMON.IOUNITS'
1832 double precision dcosom1(3),dcosom2(3)
1833 cc print *,'sss=',sss
1834 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1835 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1836 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1837 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1841 c eom12=evdwij*eps1_om12
1843 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1844 c & " sigder",sigder
1845 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1846 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1848 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1849 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1852 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
1854 c write (iout,*) "gg",(gg(k),k=1,3)
1856 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1857 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1858 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
1859 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1860 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1861 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
1862 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1863 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1864 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1865 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1868 C Calculate the components of the gradient in DC and X
1872 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1876 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1877 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1881 C-----------------------------------------------------------------------
1882 subroutine e_softsphere(evdw)
1884 C This subroutine calculates the interaction energy of nonbonded side chains
1885 C assuming the LJ potential of interaction.
1887 implicit real*8 (a-h,o-z)
1888 include 'DIMENSIONS'
1889 parameter (accur=1.0d-10)
1890 include 'COMMON.GEO'
1891 include 'COMMON.VAR'
1892 include 'COMMON.LOCAL'
1893 include 'COMMON.CHAIN'
1894 include 'COMMON.DERIV'
1895 include 'COMMON.INTERACT'
1896 include 'COMMON.TORSION'
1897 include 'COMMON.SBRIDGE'
1898 include 'COMMON.NAMES'
1899 include 'COMMON.IOUNITS'
1900 include 'COMMON.CONTACTS'
1902 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1904 do i=iatsc_s,iatsc_e
1905 itypi=iabs(itype(i))
1906 if (itypi.eq.ntyp1) cycle
1907 itypi1=iabs(itype(i+1))
1912 C Calculate SC interaction energy.
1914 do iint=1,nint_gr(i)
1915 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1916 cd & 'iend=',iend(i,iint)
1917 do j=istart(i,iint),iend(i,iint)
1918 itypj=iabs(itype(j))
1919 if (itypj.eq.ntyp1) cycle
1923 rij=xj*xj+yj*yj+zj*zj
1924 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1925 r0ij=r0(itypi,itypj)
1927 c print *,i,j,r0ij,dsqrt(rij)
1928 if (rij.lt.r0ijsq) then
1929 evdwij=0.25d0*(rij-r0ijsq)**2
1937 C Calculate the components of the gradient in DC and X
1943 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1944 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1945 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1946 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1950 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1958 C--------------------------------------------------------------------------
1959 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1962 C Soft-sphere potential of p-p interaction
1964 implicit real*8 (a-h,o-z)
1965 include 'DIMENSIONS'
1966 include 'COMMON.CONTROL'
1967 include 'COMMON.IOUNITS'
1968 include 'COMMON.GEO'
1969 include 'COMMON.VAR'
1970 include 'COMMON.LOCAL'
1971 include 'COMMON.CHAIN'
1972 include 'COMMON.DERIV'
1973 include 'COMMON.INTERACT'
1974 include 'COMMON.CONTACTS'
1975 include 'COMMON.TORSION'
1976 include 'COMMON.VECTORS'
1977 include 'COMMON.FFIELD'
1979 cd write(iout,*) 'In EELEC_soft_sphere'
1986 do i=iatel_s,iatel_e
1987 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1991 xmedi=c(1,i)+0.5d0*dxi
1992 ymedi=c(2,i)+0.5d0*dyi
1993 zmedi=c(3,i)+0.5d0*dzi
1995 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1996 do j=ielstart(i),ielend(i)
1997 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2001 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2002 r0ij=rpp(iteli,itelj)
2007 xj=c(1,j)+0.5D0*dxj-xmedi
2008 yj=c(2,j)+0.5D0*dyj-ymedi
2009 zj=c(3,j)+0.5D0*dzj-zmedi
2010 rij=xj*xj+yj*yj+zj*zj
2011 if (rij.lt.r0ijsq) then
2012 evdw1ij=0.25d0*(rij-r0ijsq)**2
2020 C Calculate contributions to the Cartesian gradient.
2026 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2027 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2030 * Loop over residues i+1 thru j-1.
2034 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2039 cgrad do i=nnt,nct-1
2041 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2043 cgrad do j=i+1,nct-1
2045 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2051 c------------------------------------------------------------------------------
2052 subroutine vec_and_deriv
2053 implicit real*8 (a-h,o-z)
2054 include 'DIMENSIONS'
2058 include 'COMMON.IOUNITS'
2059 include 'COMMON.GEO'
2060 include 'COMMON.VAR'
2061 include 'COMMON.LOCAL'
2062 include 'COMMON.CHAIN'
2063 include 'COMMON.VECTORS'
2064 include 'COMMON.SETUP'
2065 include 'COMMON.TIME1'
2066 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2067 C Compute the local reference systems. For reference system (i), the
2068 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2069 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2071 do i=ivec_start,ivec_end
2075 if (i.eq.nres-1) then
2076 C Case of the last full residue
2077 C Compute the Z-axis
2078 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2079 costh=dcos(pi-theta(nres))
2080 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2084 C Compute the derivatives of uz
2086 uzder(2,1,1)=-dc_norm(3,i-1)
2087 uzder(3,1,1)= dc_norm(2,i-1)
2088 uzder(1,2,1)= dc_norm(3,i-1)
2090 uzder(3,2,1)=-dc_norm(1,i-1)
2091 uzder(1,3,1)=-dc_norm(2,i-1)
2092 uzder(2,3,1)= dc_norm(1,i-1)
2095 uzder(2,1,2)= dc_norm(3,i)
2096 uzder(3,1,2)=-dc_norm(2,i)
2097 uzder(1,2,2)=-dc_norm(3,i)
2099 uzder(3,2,2)= dc_norm(1,i)
2100 uzder(1,3,2)= dc_norm(2,i)
2101 uzder(2,3,2)=-dc_norm(1,i)
2103 C Compute the Y-axis
2106 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2108 C Compute the derivatives of uy
2111 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2112 & -dc_norm(k,i)*dc_norm(j,i-1)
2113 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2115 uyder(j,j,1)=uyder(j,j,1)-costh
2116 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2121 uygrad(l,k,j,i)=uyder(l,k,j)
2122 uzgrad(l,k,j,i)=uzder(l,k,j)
2126 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2127 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2128 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2129 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2132 C Compute the Z-axis
2133 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2134 costh=dcos(pi-theta(i+2))
2135 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2139 C Compute the derivatives of uz
2141 uzder(2,1,1)=-dc_norm(3,i+1)
2142 uzder(3,1,1)= dc_norm(2,i+1)
2143 uzder(1,2,1)= dc_norm(3,i+1)
2145 uzder(3,2,1)=-dc_norm(1,i+1)
2146 uzder(1,3,1)=-dc_norm(2,i+1)
2147 uzder(2,3,1)= dc_norm(1,i+1)
2150 uzder(2,1,2)= dc_norm(3,i)
2151 uzder(3,1,2)=-dc_norm(2,i)
2152 uzder(1,2,2)=-dc_norm(3,i)
2154 uzder(3,2,2)= dc_norm(1,i)
2155 uzder(1,3,2)= dc_norm(2,i)
2156 uzder(2,3,2)=-dc_norm(1,i)
2158 C Compute the Y-axis
2161 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2163 C Compute the derivatives of uy
2166 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2167 & -dc_norm(k,i)*dc_norm(j,i+1)
2168 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2170 uyder(j,j,1)=uyder(j,j,1)-costh
2171 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2176 uygrad(l,k,j,i)=uyder(l,k,j)
2177 uzgrad(l,k,j,i)=uzder(l,k,j)
2181 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2182 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2183 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2184 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2188 vbld_inv_temp(1)=vbld_inv(i+1)
2189 if (i.lt.nres-1) then
2190 vbld_inv_temp(2)=vbld_inv(i+2)
2192 vbld_inv_temp(2)=vbld_inv(i)
2197 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2198 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2203 #if defined(PARVEC) && defined(MPI)
2204 if (nfgtasks1.gt.1) then
2206 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2207 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2208 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2209 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2210 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2212 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2213 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2215 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2216 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2217 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2218 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2219 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2220 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2221 time_gather=time_gather+MPI_Wtime()-time00
2223 c if (fg_rank.eq.0) then
2224 c write (iout,*) "Arrays UY and UZ"
2226 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2233 C-----------------------------------------------------------------------------
2234 subroutine check_vecgrad
2235 implicit real*8 (a-h,o-z)
2236 include 'DIMENSIONS'
2237 include 'COMMON.IOUNITS'
2238 include 'COMMON.GEO'
2239 include 'COMMON.VAR'
2240 include 'COMMON.LOCAL'
2241 include 'COMMON.CHAIN'
2242 include 'COMMON.VECTORS'
2243 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2244 dimension uyt(3,maxres),uzt(3,maxres)
2245 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2246 double precision delta /1.0d-7/
2249 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2250 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2251 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2252 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2253 cd & (dc_norm(if90,i),if90=1,3)
2254 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2255 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2256 cd write(iout,'(a)')
2262 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2263 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2276 cd write (iout,*) 'i=',i
2278 erij(k)=dc_norm(k,i)
2282 dc_norm(k,i)=erij(k)
2284 dc_norm(j,i)=dc_norm(j,i)+delta
2285 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2287 c dc_norm(k,i)=dc_norm(k,i)/fac
2289 c write (iout,*) (dc_norm(k,i),k=1,3)
2290 c write (iout,*) (erij(k),k=1,3)
2293 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2294 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2295 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2296 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2298 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2299 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2300 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2303 dc_norm(k,i)=erij(k)
2306 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2307 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2308 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2309 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2310 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2311 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2312 cd write (iout,'(a)')
2317 C--------------------------------------------------------------------------
2318 subroutine set_matrices
2319 implicit real*8 (a-h,o-z)
2320 include 'DIMENSIONS'
2323 include "COMMON.SETUP"
2325 integer status(MPI_STATUS_SIZE)
2327 include 'COMMON.IOUNITS'
2328 include 'COMMON.GEO'
2329 include 'COMMON.VAR'
2330 include 'COMMON.LOCAL'
2331 include 'COMMON.CHAIN'
2332 include 'COMMON.DERIV'
2333 include 'COMMON.INTERACT'
2334 include 'COMMON.CONTACTS'
2335 include 'COMMON.TORSION'
2336 include 'COMMON.VECTORS'
2337 include 'COMMON.FFIELD'
2338 double precision auxvec(2),auxmat(2,2)
2340 C Compute the virtual-bond-torsional-angle dependent quantities needed
2341 C to calculate the el-loc multibody terms of various order.
2344 do i=ivec_start+2,ivec_end+2
2348 if (i .lt. nres+1) then
2385 if (i .gt. 3 .and. i .lt. nres+1) then
2386 obrot_der(1,i-2)=-sin1
2387 obrot_der(2,i-2)= cos1
2388 Ugder(1,1,i-2)= sin1
2389 Ugder(1,2,i-2)=-cos1
2390 Ugder(2,1,i-2)=-cos1
2391 Ugder(2,2,i-2)=-sin1
2394 obrot2_der(1,i-2)=-dwasin2
2395 obrot2_der(2,i-2)= dwacos2
2396 Ug2der(1,1,i-2)= dwasin2
2397 Ug2der(1,2,i-2)=-dwacos2
2398 Ug2der(2,1,i-2)=-dwacos2
2399 Ug2der(2,2,i-2)=-dwasin2
2401 obrot_der(1,i-2)=0.0d0
2402 obrot_der(2,i-2)=0.0d0
2403 Ugder(1,1,i-2)=0.0d0
2404 Ugder(1,2,i-2)=0.0d0
2405 Ugder(2,1,i-2)=0.0d0
2406 Ugder(2,2,i-2)=0.0d0
2407 obrot2_der(1,i-2)=0.0d0
2408 obrot2_der(2,i-2)=0.0d0
2409 Ug2der(1,1,i-2)=0.0d0
2410 Ug2der(1,2,i-2)=0.0d0
2411 Ug2der(2,1,i-2)=0.0d0
2412 Ug2der(2,2,i-2)=0.0d0
2414 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2415 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2416 iti = itortyp(itype(i-2))
2420 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2421 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2422 iti1 = itortyp(itype(i-1))
2426 cd write (iout,*) '*******i',i,' iti1',iti
2427 cd write (iout,*) 'b1',b1(:,iti)
2428 cd write (iout,*) 'b2',b2(:,iti)
2429 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2430 c if (i .gt. iatel_s+2) then
2431 if (i .gt. nnt+2) then
2432 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2433 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2434 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2436 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2437 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2438 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2439 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2440 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2451 DtUg2(l,k,i-2)=0.0d0
2455 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2456 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2458 muder(k,i-2)=Ub2der(k,i-2)
2460 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2461 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2462 if (itype(i-1).le.ntyp) then
2463 iti1 = itortyp(itype(i-1))
2471 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2473 cd write (iout,*) 'mu ',mu(:,i-2)
2474 cd write (iout,*) 'mu1',mu1(:,i-2)
2475 cd write (iout,*) 'mu2',mu2(:,i-2)
2476 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2478 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2479 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2480 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2481 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2482 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2483 C Vectors and matrices dependent on a single virtual-bond dihedral.
2484 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2485 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2486 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2487 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2488 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2489 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2490 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2491 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2492 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2495 C Matrices dependent on two consecutive virtual-bond dihedrals.
2496 C The order of matrices is from left to right.
2497 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2499 c do i=max0(ivec_start,2),ivec_end
2501 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2502 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2503 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2504 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2505 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2506 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2507 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2508 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2511 #if defined(MPI) && defined(PARMAT)
2513 c if (fg_rank.eq.0) then
2514 write (iout,*) "Arrays UG and UGDER before GATHER"
2516 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2517 & ((ug(l,k,i),l=1,2),k=1,2),
2518 & ((ugder(l,k,i),l=1,2),k=1,2)
2520 write (iout,*) "Arrays UG2 and UG2DER"
2522 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2523 & ((ug2(l,k,i),l=1,2),k=1,2),
2524 & ((ug2der(l,k,i),l=1,2),k=1,2)
2526 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2528 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2529 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2530 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2532 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2534 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2535 & costab(i),sintab(i),costab2(i),sintab2(i)
2537 write (iout,*) "Array MUDER"
2539 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2543 if (nfgtasks.gt.1) then
2545 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2546 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2547 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2549 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2550 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2552 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2553 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2555 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2556 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2558 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2559 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2561 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2562 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2564 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2565 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2567 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2568 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2569 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2570 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2571 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2572 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2573 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2574 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2575 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2576 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2577 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2578 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2579 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2581 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2582 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2584 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2585 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2587 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2588 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2590 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2591 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2593 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2594 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2596 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2597 & ivec_count(fg_rank1),
2598 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2600 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2601 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2603 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2604 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2606 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2607 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2609 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2610 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2612 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2613 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2615 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2616 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2618 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2619 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2621 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2622 & ivec_count(fg_rank1),
2623 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2625 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2626 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2628 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2629 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2631 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2632 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2634 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2635 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2637 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2638 & ivec_count(fg_rank1),
2639 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2641 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2642 & ivec_count(fg_rank1),
2643 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2645 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2646 & ivec_count(fg_rank1),
2647 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2648 & MPI_MAT2,FG_COMM1,IERR)
2649 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2650 & ivec_count(fg_rank1),
2651 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2652 & MPI_MAT2,FG_COMM1,IERR)
2655 c Passes matrix info through the ring
2658 if (irecv.lt.0) irecv=nfgtasks1-1
2661 if (inext.ge.nfgtasks1) inext=0
2663 c write (iout,*) "isend",isend," irecv",irecv
2665 lensend=lentyp(isend)
2666 lenrecv=lentyp(irecv)
2667 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2668 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2669 c & MPI_ROTAT1(lensend),inext,2200+isend,
2670 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2671 c & iprev,2200+irecv,FG_COMM,status,IERR)
2672 c write (iout,*) "Gather ROTAT1"
2674 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2675 c & MPI_ROTAT2(lensend),inext,3300+isend,
2676 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2677 c & iprev,3300+irecv,FG_COMM,status,IERR)
2678 c write (iout,*) "Gather ROTAT2"
2680 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2681 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2682 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2683 & iprev,4400+irecv,FG_COMM,status,IERR)
2684 c write (iout,*) "Gather ROTAT_OLD"
2686 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2687 & MPI_PRECOMP11(lensend),inext,5500+isend,
2688 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2689 & iprev,5500+irecv,FG_COMM,status,IERR)
2690 c write (iout,*) "Gather PRECOMP11"
2692 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2693 & MPI_PRECOMP12(lensend),inext,6600+isend,
2694 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2695 & iprev,6600+irecv,FG_COMM,status,IERR)
2696 c write (iout,*) "Gather PRECOMP12"
2698 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2700 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2701 & MPI_ROTAT2(lensend),inext,7700+isend,
2702 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2703 & iprev,7700+irecv,FG_COMM,status,IERR)
2704 c write (iout,*) "Gather PRECOMP21"
2706 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2707 & MPI_PRECOMP22(lensend),inext,8800+isend,
2708 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2709 & iprev,8800+irecv,FG_COMM,status,IERR)
2710 c write (iout,*) "Gather PRECOMP22"
2712 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2713 & MPI_PRECOMP23(lensend),inext,9900+isend,
2714 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2715 & MPI_PRECOMP23(lenrecv),
2716 & iprev,9900+irecv,FG_COMM,status,IERR)
2717 c write (iout,*) "Gather PRECOMP23"
2722 if (irecv.lt.0) irecv=nfgtasks1-1
2725 time_gather=time_gather+MPI_Wtime()-time00
2728 c if (fg_rank.eq.0) then
2729 write (iout,*) "Arrays UG and UGDER"
2731 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2732 & ((ug(l,k,i),l=1,2),k=1,2),
2733 & ((ugder(l,k,i),l=1,2),k=1,2)
2735 write (iout,*) "Arrays UG2 and UG2DER"
2737 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2738 & ((ug2(l,k,i),l=1,2),k=1,2),
2739 & ((ug2der(l,k,i),l=1,2),k=1,2)
2741 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2743 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2744 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2745 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2747 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2749 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2750 & costab(i),sintab(i),costab2(i),sintab2(i)
2752 write (iout,*) "Array MUDER"
2754 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2760 cd iti = itortyp(itype(i))
2763 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2764 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2769 C--------------------------------------------------------------------------
2770 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2772 C This subroutine calculates the average interaction energy and its gradient
2773 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2774 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2775 C The potential depends both on the distance of peptide-group centers and on
2776 C the orientation of the CA-CA virtual bonds.
2778 implicit real*8 (a-h,o-z)
2782 include 'DIMENSIONS'
2783 include 'COMMON.CONTROL'
2784 include 'COMMON.SETUP'
2785 include 'COMMON.IOUNITS'
2786 include 'COMMON.GEO'
2787 include 'COMMON.VAR'
2788 include 'COMMON.LOCAL'
2789 include 'COMMON.CHAIN'
2790 include 'COMMON.DERIV'
2791 include 'COMMON.INTERACT'
2792 include 'COMMON.CONTACTS'
2793 include 'COMMON.TORSION'
2794 include 'COMMON.VECTORS'
2795 include 'COMMON.FFIELD'
2796 include 'COMMON.TIME1'
2797 include 'COMMON.SPLITELE'
2798 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2799 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2800 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2801 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2802 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2803 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2805 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2807 double precision scal_el /1.0d0/
2809 double precision scal_el /0.5d0/
2812 C 13-go grudnia roku pamietnego...
2813 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2814 & 0.0d0,1.0d0,0.0d0,
2815 & 0.0d0,0.0d0,1.0d0/
2816 cd write(iout,*) 'In EELEC'
2818 cd write(iout,*) 'Type',i
2819 cd write(iout,*) 'B1',B1(:,i)
2820 cd write(iout,*) 'B2',B2(:,i)
2821 cd write(iout,*) 'CC',CC(:,:,i)
2822 cd write(iout,*) 'DD',DD(:,:,i)
2823 cd write(iout,*) 'EE',EE(:,:,i)
2825 cd call check_vecgrad
2827 if (icheckgrad.eq.1) then
2829 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2831 dc_norm(k,i)=dc(k,i)*fac
2833 c write (iout,*) 'i',i,' fac',fac
2836 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2837 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2838 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2839 c call vec_and_deriv
2845 time_mat=time_mat+MPI_Wtime()-time01
2849 cd write (iout,*) 'i=',i
2851 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2854 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2855 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2868 cd print '(a)','Enter EELEC'
2869 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2871 gel_loc_loc(i)=0.0d0
2876 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2878 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2880 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
2881 do i=iturn3_start,iturn3_end
2882 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2883 & .or. itype(i+2).eq.ntyp1
2884 & .or. itype(i+3).eq.ntyp1
2885 & .or. itype(i-1).eq.ntyp1
2886 & .or. itype(i+4).eq.ntyp1
2891 dx_normi=dc_norm(1,i)
2892 dy_normi=dc_norm(2,i)
2893 dz_normi=dc_norm(3,i)
2894 xmedi=c(1,i)+0.5d0*dxi
2895 ymedi=c(2,i)+0.5d0*dyi
2896 zmedi=c(3,i)+0.5d0*dzi
2897 C Return atom into box, boxxsize is size of box in x dimension
2899 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2900 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2901 C Condition for being inside the proper box
2902 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
2903 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
2907 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
2908 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2909 cC Condition for being inside the proper box
2910 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
2911 c & (ymedi.lt.((-0.5d0)*boxysize))) then
2915 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2916 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2917 cC Condition for being inside the proper box
2918 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
2919 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
2922 xmedi=mod(xmedi,boxxsize)
2923 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2924 ymedi=mod(ymedi,boxysize)
2925 if (ymedi.lt.0) ymedi=ymedi+boxysize
2926 zmedi=mod(zmedi,boxzsize)
2927 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2929 call eelecij(i,i+2,ees,evdw1,eel_loc)
2930 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2931 num_cont_hb(i)=num_conti
2933 do i=iturn4_start,iturn4_end
2934 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2935 & .or. itype(i+3).eq.ntyp1
2936 & .or. itype(i+4).eq.ntyp1
2937 & .or. itype(i+5).eq.ntyp1
2938 & .or. itype(i).eq.ntyp1
2939 & .or. itype(i-1).eq.ntyp1
2944 dx_normi=dc_norm(1,i)
2945 dy_normi=dc_norm(2,i)
2946 dz_normi=dc_norm(3,i)
2947 xmedi=c(1,i)+0.5d0*dxi
2948 ymedi=c(2,i)+0.5d0*dyi
2949 zmedi=c(3,i)+0.5d0*dzi
2950 C Return atom into box, boxxsize is size of box in x dimension
2952 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2953 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2954 C Condition for being inside the proper box
2955 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
2956 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
2960 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
2961 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2962 C Condition for being inside the proper box
2963 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
2964 c & (ymedi.lt.((-0.5d0)*boxysize))) then
2968 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2969 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2970 C Condition for being inside the proper box
2971 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
2972 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
2975 xmedi=mod(xmedi,boxxsize)
2976 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2977 ymedi=mod(ymedi,boxysize)
2978 if (ymedi.lt.0) ymedi=ymedi+boxysize
2979 zmedi=mod(zmedi,boxzsize)
2980 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2982 num_conti=num_cont_hb(i)
2983 call eelecij(i,i+3,ees,evdw1,eel_loc)
2984 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2985 & call eturn4(i,eello_turn4)
2986 num_cont_hb(i)=num_conti
2988 C Loop over all neighbouring boxes
2993 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2995 do i=iatel_s,iatel_e
2996 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2997 & .or. itype(i+2).eq.ntyp1
2998 & .or. itype(i-1).eq.ntyp1
3003 dx_normi=dc_norm(1,i)
3004 dy_normi=dc_norm(2,i)
3005 dz_normi=dc_norm(3,i)
3006 xmedi=c(1,i)+0.5d0*dxi
3007 ymedi=c(2,i)+0.5d0*dyi
3008 zmedi=c(3,i)+0.5d0*dzi
3009 xmedi=mod(xmedi,boxxsize)
3010 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3011 ymedi=mod(ymedi,boxysize)
3012 if (ymedi.lt.0) ymedi=ymedi+boxysize
3013 zmedi=mod(zmedi,boxzsize)
3014 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3016 C Return atom into box, boxxsize is size of box in x dimension
3018 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3019 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3020 C Condition for being inside the proper box
3021 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3022 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3026 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3027 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3028 C Condition for being inside the proper box
3029 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3030 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3034 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3035 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3036 cC Condition for being inside the proper box
3037 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3038 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3042 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3043 num_conti=num_cont_hb(i)
3044 do j=ielstart(i),ielend(i)
3045 c write (iout,*) i,j,itype(i),itype(j)
3046 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3047 & .or.itype(j+2).eq.ntyp1
3048 & .or.itype(j-1).eq.ntyp1
3050 call eelecij(i,j,ees,evdw1,eel_loc)
3052 num_cont_hb(i)=num_conti
3058 c write (iout,*) "Number of loop steps in EELEC:",ind
3060 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3061 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3063 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3064 ccc eel_loc=eel_loc+eello_turn3
3065 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3068 C-------------------------------------------------------------------------------
3069 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3070 implicit real*8 (a-h,o-z)
3071 include 'DIMENSIONS'
3075 include 'COMMON.CONTROL'
3076 include 'COMMON.IOUNITS'
3077 include 'COMMON.GEO'
3078 include 'COMMON.VAR'
3079 include 'COMMON.LOCAL'
3080 include 'COMMON.CHAIN'
3081 include 'COMMON.DERIV'
3082 include 'COMMON.INTERACT'
3083 include 'COMMON.CONTACTS'
3084 include 'COMMON.TORSION'
3085 include 'COMMON.VECTORS'
3086 include 'COMMON.FFIELD'
3087 include 'COMMON.TIME1'
3088 include 'COMMON.SPLITELE'
3089 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3090 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3091 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3092 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3093 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3094 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3096 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3098 double precision scal_el /1.0d0/
3100 double precision scal_el /0.5d0/
3103 C 13-go grudnia roku pamietnego...
3104 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3105 & 0.0d0,1.0d0,0.0d0,
3106 & 0.0d0,0.0d0,1.0d0/
3107 c time00=MPI_Wtime()
3108 cd write (iout,*) "eelecij",i,j
3112 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3113 aaa=app(iteli,itelj)
3114 bbb=bpp(iteli,itelj)
3115 ael6i=ael6(iteli,itelj)
3116 ael3i=ael3(iteli,itelj)
3120 dx_normj=dc_norm(1,j)
3121 dy_normj=dc_norm(2,j)
3122 dz_normj=dc_norm(3,j)
3123 C xj=c(1,j)+0.5D0*dxj-xmedi
3124 C yj=c(2,j)+0.5D0*dyj-ymedi
3125 C zj=c(3,j)+0.5D0*dzj-zmedi
3130 if (xj.lt.0) xj=xj+boxxsize
3132 if (yj.lt.0) yj=yj+boxysize
3134 if (zj.lt.0) zj=zj+boxzsize
3136 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3138 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3139 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3140 C Condition for being inside the proper box
3141 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3142 c & (xj.lt.((-0.5d0)*boxxsize))) then
3146 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3147 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3148 C Condition for being inside the proper box
3149 c if ((yj.gt.((0.5d0)*boxysize)).or.
3150 c & (yj.lt.((-0.5d0)*boxysize))) then
3154 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3155 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3156 C Condition for being inside the proper box
3157 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3158 c & (zj.lt.((-0.5d0)*boxzsize))) then
3161 C endif !endPBC condintion
3165 rij=xj*xj+yj*yj+zj*zj
3167 sss=sscale(sqrt(rij))
3168 sssgrad=sscagrad(sqrt(rij))
3169 c if (sss.gt.0.0d0) then
3175 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3176 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3177 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3178 fac=cosa-3.0D0*cosb*cosg
3180 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3181 if (j.eq.i+2) ev1=scal_el*ev1
3186 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3190 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3191 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3193 evdw1=evdw1+evdwij*sss
3194 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3195 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3196 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3197 cd & xmedi,ymedi,zmedi,xj,yj,zj
3199 if (energy_dec) then
3200 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3202 &,iteli,itelj,aaa,evdw1
3203 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3207 C Calculate contributions to the Cartesian gradient.
3210 facvdw=-6*rrmij*(ev1+evdwij)*sss
3211 facel=-3*rrmij*(el1+eesij)
3217 * Radial derivatives. First process both termini of the fragment (i,j)
3223 c ghalf=0.5D0*ggg(k)
3224 c gelc(k,i)=gelc(k,i)+ghalf
3225 c gelc(k,j)=gelc(k,j)+ghalf
3227 c 9/28/08 AL Gradient compotents will be summed only at the end
3229 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3230 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3233 * Loop over residues i+1 thru j-1.
3237 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3240 if (sss.gt.0.0) then
3241 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3242 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3243 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3250 c ghalf=0.5D0*ggg(k)
3251 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3252 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3254 c 9/28/08 AL Gradient compotents will be summed only at the end
3256 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3257 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3260 * Loop over residues i+1 thru j-1.
3264 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3269 facvdw=(ev1+evdwij)*sss
3272 fac=-3*rrmij*(facvdw+facvdw+facel)
3277 * Radial derivatives. First process both termini of the fragment (i,j)
3283 c ghalf=0.5D0*ggg(k)
3284 c gelc(k,i)=gelc(k,i)+ghalf
3285 c gelc(k,j)=gelc(k,j)+ghalf
3287 c 9/28/08 AL Gradient compotents will be summed only at the end
3289 gelc_long(k,j)=gelc(k,j)+ggg(k)
3290 gelc_long(k,i)=gelc(k,i)-ggg(k)
3293 * Loop over residues i+1 thru j-1.
3297 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3300 c 9/28/08 AL Gradient compotents will be summed only at the end
3301 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3302 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3303 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3305 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3306 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3312 ecosa=2.0D0*fac3*fac1+fac4
3315 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3316 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3318 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3319 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3321 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3322 cd & (dcosg(k),k=1,3)
3324 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3327 c ghalf=0.5D0*ggg(k)
3328 c gelc(k,i)=gelc(k,i)+ghalf
3329 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3330 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3331 c gelc(k,j)=gelc(k,j)+ghalf
3332 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3333 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3337 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3342 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3343 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3345 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3346 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3347 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3348 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3352 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3353 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3354 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3356 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3357 C energy of a peptide unit is assumed in the form of a second-order
3358 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3359 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3360 C are computed for EVERY pair of non-contiguous peptide groups.
3362 if (j.lt.nres-1) then
3373 muij(kkk)=mu(k,i)*mu(l,j)
3376 cd write (iout,*) 'EELEC: i',i,' j',j
3377 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3378 cd write(iout,*) 'muij',muij
3379 ury=scalar(uy(1,i),erij)
3380 urz=scalar(uz(1,i),erij)
3381 vry=scalar(uy(1,j),erij)
3382 vrz=scalar(uz(1,j),erij)
3383 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3384 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3385 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3386 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3387 fac=dsqrt(-ael6i)*r3ij
3392 cd write (iout,'(4i5,4f10.5)')
3393 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3394 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3395 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3396 cd & uy(:,j),uz(:,j)
3397 cd write (iout,'(4f10.5)')
3398 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3399 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3400 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3401 cd write (iout,'(9f10.5/)')
3402 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3403 C Derivatives of the elements of A in virtual-bond vectors
3404 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3406 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3407 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3408 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3409 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3410 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3411 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3412 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3413 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3414 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3415 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3416 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3417 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3419 C Compute radial contributions to the gradient
3437 C Add the contributions coming from er
3440 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3441 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3442 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3443 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3446 C Derivatives in DC(i)
3447 cgrad ghalf1=0.5d0*agg(k,1)
3448 cgrad ghalf2=0.5d0*agg(k,2)
3449 cgrad ghalf3=0.5d0*agg(k,3)
3450 cgrad ghalf4=0.5d0*agg(k,4)
3451 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3452 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3453 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3454 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3455 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3456 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3457 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3458 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3459 C Derivatives in DC(i+1)
3460 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3461 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3462 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3463 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3464 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3465 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3466 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3467 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3468 C Derivatives in DC(j)
3469 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3470 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3471 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3472 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3473 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3474 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3475 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3476 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3477 C Derivatives in DC(j+1) or DC(nres-1)
3478 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3479 & -3.0d0*vryg(k,3)*ury)
3480 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3481 & -3.0d0*vrzg(k,3)*ury)
3482 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3483 & -3.0d0*vryg(k,3)*urz)
3484 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3485 & -3.0d0*vrzg(k,3)*urz)
3486 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3488 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3501 aggi(k,l)=-aggi(k,l)
3502 aggi1(k,l)=-aggi1(k,l)
3503 aggj(k,l)=-aggj(k,l)
3504 aggj1(k,l)=-aggj1(k,l)
3507 if (j.lt.nres-1) then
3513 aggi(k,l)=-aggi(k,l)
3514 aggi1(k,l)=-aggi1(k,l)
3515 aggj(k,l)=-aggj(k,l)
3516 aggj1(k,l)=-aggj1(k,l)
3527 aggi(k,l)=-aggi(k,l)
3528 aggi1(k,l)=-aggi1(k,l)
3529 aggj(k,l)=-aggj(k,l)
3530 aggj1(k,l)=-aggj1(k,l)
3535 IF (wel_loc.gt.0.0d0) THEN
3536 C Contribution to the local-electrostatic energy coming from the i-j pair
3537 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3539 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3540 c & ' eel_loc_ij',eel_loc_ij
3542 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3543 & 'eelloc',i,j,eel_loc_ij
3544 c if (eel_loc_ij.ne.0)
3545 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3546 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3548 eel_loc=eel_loc+eel_loc_ij
3549 C Partial derivatives in virtual-bond dihedral angles gamma
3551 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3552 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3553 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3554 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3555 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3556 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3557 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3559 ggg(l)=agg(l,1)*muij(1)+
3560 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3561 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3562 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3563 cgrad ghalf=0.5d0*ggg(l)
3564 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3565 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3569 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3572 C Remaining derivatives of eello
3574 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3575 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3576 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3577 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3578 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3579 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3580 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3581 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3584 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3585 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3586 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3587 & .and. num_conti.le.maxconts) then
3588 c write (iout,*) i,j," entered corr"
3590 C Calculate the contact function. The ith column of the array JCONT will
3591 C contain the numbers of atoms that make contacts with the atom I (of numbers
3592 C greater than I). The arrays FACONT and GACONT will contain the values of
3593 C the contact function and its derivative.
3594 c r0ij=1.02D0*rpp(iteli,itelj)
3595 c r0ij=1.11D0*rpp(iteli,itelj)
3596 r0ij=2.20D0*rpp(iteli,itelj)
3597 c r0ij=1.55D0*rpp(iteli,itelj)
3598 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3599 if (fcont.gt.0.0D0) then
3600 num_conti=num_conti+1
3601 if (num_conti.gt.maxconts) then
3602 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3603 & ' will skip next contacts for this conf.'
3605 jcont_hb(num_conti,i)=j
3606 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3607 cd & " jcont_hb",jcont_hb(num_conti,i)
3608 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3609 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3610 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3612 d_cont(num_conti,i)=rij
3613 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3614 C --- Electrostatic-interaction matrix ---
3615 a_chuj(1,1,num_conti,i)=a22
3616 a_chuj(1,2,num_conti,i)=a23
3617 a_chuj(2,1,num_conti,i)=a32
3618 a_chuj(2,2,num_conti,i)=a33
3619 C --- Gradient of rij
3621 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3628 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3629 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3630 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3631 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3632 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3637 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3638 C Calculate contact energies
3640 wij=cosa-3.0D0*cosb*cosg
3643 c fac3=dsqrt(-ael6i)/r0ij**3
3644 fac3=dsqrt(-ael6i)*r3ij
3645 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3646 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3647 if (ees0tmp.gt.0) then
3648 ees0pij=dsqrt(ees0tmp)
3652 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3653 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3654 if (ees0tmp.gt.0) then
3655 ees0mij=dsqrt(ees0tmp)
3660 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3661 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3662 C Diagnostics. Comment out or remove after debugging!
3663 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3664 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3665 c ees0m(num_conti,i)=0.0D0
3667 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3668 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3669 C Angular derivatives of the contact function
3670 ees0pij1=fac3/ees0pij
3671 ees0mij1=fac3/ees0mij
3672 fac3p=-3.0D0*fac3*rrmij
3673 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3674 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3676 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3677 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3678 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3679 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3680 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3681 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3682 ecosap=ecosa1+ecosa2
3683 ecosbp=ecosb1+ecosb2
3684 ecosgp=ecosg1+ecosg2
3685 ecosam=ecosa1-ecosa2
3686 ecosbm=ecosb1-ecosb2
3687 ecosgm=ecosg1-ecosg2
3696 facont_hb(num_conti,i)=fcont
3697 fprimcont=fprimcont/rij
3698 cd facont_hb(num_conti,i)=1.0D0
3699 C Following line is for diagnostics.
3702 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3703 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3706 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3707 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3709 gggp(1)=gggp(1)+ees0pijp*xj
3710 gggp(2)=gggp(2)+ees0pijp*yj
3711 gggp(3)=gggp(3)+ees0pijp*zj
3712 gggm(1)=gggm(1)+ees0mijp*xj
3713 gggm(2)=gggm(2)+ees0mijp*yj
3714 gggm(3)=gggm(3)+ees0mijp*zj
3715 C Derivatives due to the contact function
3716 gacont_hbr(1,num_conti,i)=fprimcont*xj
3717 gacont_hbr(2,num_conti,i)=fprimcont*yj
3718 gacont_hbr(3,num_conti,i)=fprimcont*zj
3721 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3722 c following the change of gradient-summation algorithm.
3724 cgrad ghalfp=0.5D0*gggp(k)
3725 cgrad ghalfm=0.5D0*gggm(k)
3726 gacontp_hb1(k,num_conti,i)=!ghalfp
3727 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3728 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3729 gacontp_hb2(k,num_conti,i)=!ghalfp
3730 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3731 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3732 gacontp_hb3(k,num_conti,i)=gggp(k)
3733 gacontm_hb1(k,num_conti,i)=!ghalfm
3734 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3735 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3736 gacontm_hb2(k,num_conti,i)=!ghalfm
3737 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3738 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3739 gacontm_hb3(k,num_conti,i)=gggm(k)
3741 C Diagnostics. Comment out or remove after debugging!
3743 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3744 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3745 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3746 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3747 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3748 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3751 endif ! num_conti.le.maxconts
3754 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3757 ghalf=0.5d0*agg(l,k)
3758 aggi(l,k)=aggi(l,k)+ghalf
3759 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3760 aggj(l,k)=aggj(l,k)+ghalf
3763 if (j.eq.nres-1 .and. i.lt.j-2) then
3766 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3771 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3774 C-----------------------------------------------------------------------------
3775 subroutine eturn3(i,eello_turn3)
3776 C Third- and fourth-order contributions from turns
3777 implicit real*8 (a-h,o-z)
3778 include 'DIMENSIONS'
3779 include 'COMMON.IOUNITS'
3780 include 'COMMON.GEO'
3781 include 'COMMON.VAR'
3782 include 'COMMON.LOCAL'
3783 include 'COMMON.CHAIN'
3784 include 'COMMON.DERIV'
3785 include 'COMMON.INTERACT'
3786 include 'COMMON.CONTACTS'
3787 include 'COMMON.TORSION'
3788 include 'COMMON.VECTORS'
3789 include 'COMMON.FFIELD'
3790 include 'COMMON.CONTROL'
3792 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3793 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3794 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3795 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3796 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3797 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3798 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3801 c write (iout,*) "eturn3",i,j,j1,j2
3806 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3808 C Third-order contributions
3815 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3816 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3817 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3818 call transpose2(auxmat(1,1),auxmat1(1,1))
3819 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3820 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3821 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3822 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3823 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3824 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3825 cd & ' eello_turn3_num',4*eello_turn3_num
3826 C Derivatives in gamma(i)
3827 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3828 call transpose2(auxmat2(1,1),auxmat3(1,1))
3829 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3830 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3831 C Derivatives in gamma(i+1)
3832 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3833 call transpose2(auxmat2(1,1),auxmat3(1,1))
3834 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3835 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3836 & +0.5d0*(pizda(1,1)+pizda(2,2))
3837 C Cartesian derivatives
3839 c ghalf1=0.5d0*agg(l,1)
3840 c ghalf2=0.5d0*agg(l,2)
3841 c ghalf3=0.5d0*agg(l,3)
3842 c ghalf4=0.5d0*agg(l,4)
3843 a_temp(1,1)=aggi(l,1)!+ghalf1
3844 a_temp(1,2)=aggi(l,2)!+ghalf2
3845 a_temp(2,1)=aggi(l,3)!+ghalf3
3846 a_temp(2,2)=aggi(l,4)!+ghalf4
3847 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3848 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3849 & +0.5d0*(pizda(1,1)+pizda(2,2))
3850 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3851 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3852 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3853 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3854 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3855 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3856 & +0.5d0*(pizda(1,1)+pizda(2,2))
3857 a_temp(1,1)=aggj(l,1)!+ghalf1
3858 a_temp(1,2)=aggj(l,2)!+ghalf2
3859 a_temp(2,1)=aggj(l,3)!+ghalf3
3860 a_temp(2,2)=aggj(l,4)!+ghalf4
3861 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3862 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3863 & +0.5d0*(pizda(1,1)+pizda(2,2))
3864 a_temp(1,1)=aggj1(l,1)
3865 a_temp(1,2)=aggj1(l,2)
3866 a_temp(2,1)=aggj1(l,3)
3867 a_temp(2,2)=aggj1(l,4)
3868 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3869 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3870 & +0.5d0*(pizda(1,1)+pizda(2,2))
3874 C-------------------------------------------------------------------------------
3875 subroutine eturn4(i,eello_turn4)
3876 C Third- and fourth-order contributions from turns
3877 implicit real*8 (a-h,o-z)
3878 include 'DIMENSIONS'
3879 include 'COMMON.IOUNITS'
3880 include 'COMMON.GEO'
3881 include 'COMMON.VAR'
3882 include 'COMMON.LOCAL'
3883 include 'COMMON.CHAIN'
3884 include 'COMMON.DERIV'
3885 include 'COMMON.INTERACT'
3886 include 'COMMON.CONTACTS'
3887 include 'COMMON.TORSION'
3888 include 'COMMON.VECTORS'
3889 include 'COMMON.FFIELD'
3890 include 'COMMON.CONTROL'
3892 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3893 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3894 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3895 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3896 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3897 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3898 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3901 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3903 C Fourth-order contributions
3911 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3912 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3913 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3918 iti1=itortyp(itype(i+1))
3919 iti2=itortyp(itype(i+2))
3920 iti3=itortyp(itype(i+3))
3921 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3922 call transpose2(EUg(1,1,i+1),e1t(1,1))
3923 call transpose2(Eug(1,1,i+2),e2t(1,1))
3924 call transpose2(Eug(1,1,i+3),e3t(1,1))
3925 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3926 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3927 s1=scalar2(b1(1,iti2),auxvec(1))
3928 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3929 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3930 s2=scalar2(b1(1,iti1),auxvec(1))
3931 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3932 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3933 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3934 eello_turn4=eello_turn4-(s1+s2+s3)
3935 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
3936 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
3937 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
3938 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3939 cd & ' eello_turn4_num',8*eello_turn4_num
3940 C Derivatives in gamma(i)
3941 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3942 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3943 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3944 s1=scalar2(b1(1,iti2),auxvec(1))
3945 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3946 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3947 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3948 C Derivatives in gamma(i+1)
3949 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3950 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3951 s2=scalar2(b1(1,iti1),auxvec(1))
3952 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3953 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3954 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3955 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3956 C Derivatives in gamma(i+2)
3957 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3958 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3959 s1=scalar2(b1(1,iti2),auxvec(1))
3960 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3961 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3962 s2=scalar2(b1(1,iti1),auxvec(1))
3963 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3964 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3965 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3966 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3967 C Cartesian derivatives
3968 C Derivatives of this turn contributions in DC(i+2)
3969 if (j.lt.nres-1) then
3971 a_temp(1,1)=agg(l,1)
3972 a_temp(1,2)=agg(l,2)
3973 a_temp(2,1)=agg(l,3)
3974 a_temp(2,2)=agg(l,4)
3975 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3976 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3977 s1=scalar2(b1(1,iti2),auxvec(1))
3978 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3979 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3980 s2=scalar2(b1(1,iti1),auxvec(1))
3981 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3982 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3983 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3985 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3988 C Remaining derivatives of this turn contribution
3990 a_temp(1,1)=aggi(l,1)
3991 a_temp(1,2)=aggi(l,2)
3992 a_temp(2,1)=aggi(l,3)
3993 a_temp(2,2)=aggi(l,4)
3994 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3995 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3996 s1=scalar2(b1(1,iti2),auxvec(1))
3997 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3998 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3999 s2=scalar2(b1(1,iti1),auxvec(1))
4000 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4001 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4002 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4003 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4004 a_temp(1,1)=aggi1(l,1)
4005 a_temp(1,2)=aggi1(l,2)
4006 a_temp(2,1)=aggi1(l,3)
4007 a_temp(2,2)=aggi1(l,4)
4008 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4009 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4010 s1=scalar2(b1(1,iti2),auxvec(1))
4011 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4012 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4013 s2=scalar2(b1(1,iti1),auxvec(1))
4014 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4015 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4016 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4017 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4018 a_temp(1,1)=aggj(l,1)
4019 a_temp(1,2)=aggj(l,2)
4020 a_temp(2,1)=aggj(l,3)
4021 a_temp(2,2)=aggj(l,4)
4022 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4023 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4024 s1=scalar2(b1(1,iti2),auxvec(1))
4025 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4026 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4027 s2=scalar2(b1(1,iti1),auxvec(1))
4028 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4029 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4030 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4031 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4032 a_temp(1,1)=aggj1(l,1)
4033 a_temp(1,2)=aggj1(l,2)
4034 a_temp(2,1)=aggj1(l,3)
4035 a_temp(2,2)=aggj1(l,4)
4036 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4037 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4038 s1=scalar2(b1(1,iti2),auxvec(1))
4039 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4040 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4041 s2=scalar2(b1(1,iti1),auxvec(1))
4042 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4043 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4044 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4045 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4046 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4050 C-----------------------------------------------------------------------------
4051 subroutine vecpr(u,v,w)
4052 implicit real*8(a-h,o-z)
4053 dimension u(3),v(3),w(3)
4054 w(1)=u(2)*v(3)-u(3)*v(2)
4055 w(2)=-u(1)*v(3)+u(3)*v(1)
4056 w(3)=u(1)*v(2)-u(2)*v(1)
4059 C-----------------------------------------------------------------------------
4060 subroutine unormderiv(u,ugrad,unorm,ungrad)
4061 C This subroutine computes the derivatives of a normalized vector u, given
4062 C the derivatives computed without normalization conditions, ugrad. Returns
4065 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4066 double precision vec(3)
4067 double precision scalar
4069 c write (2,*) 'ugrad',ugrad
4072 vec(i)=scalar(ugrad(1,i),u(1))
4074 c write (2,*) 'vec',vec
4077 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4080 c write (2,*) 'ungrad',ungrad
4083 C-----------------------------------------------------------------------------
4084 subroutine escp_soft_sphere(evdw2,evdw2_14)
4086 C This subroutine calculates the excluded-volume interaction energy between
4087 C peptide-group centers and side chains and its gradient in virtual-bond and
4088 C side-chain vectors.
4090 implicit real*8 (a-h,o-z)
4091 include 'DIMENSIONS'
4092 include 'COMMON.GEO'
4093 include 'COMMON.VAR'
4094 include 'COMMON.LOCAL'
4095 include 'COMMON.CHAIN'
4096 include 'COMMON.DERIV'
4097 include 'COMMON.INTERACT'
4098 include 'COMMON.FFIELD'
4099 include 'COMMON.IOUNITS'
4100 include 'COMMON.CONTROL'
4105 cd print '(a)','Enter ESCP'
4106 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4110 do i=iatscp_s,iatscp_e
4111 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4113 xi=0.5D0*(c(1,i)+c(1,i+1))
4114 yi=0.5D0*(c(2,i)+c(2,i+1))
4115 zi=0.5D0*(c(3,i)+c(3,i+1))
4116 C Return atom into box, boxxsize is size of box in x dimension
4118 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4119 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4120 C Condition for being inside the proper box
4121 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4122 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4126 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4127 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4128 C Condition for being inside the proper box
4129 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4130 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4134 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4135 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4136 cC Condition for being inside the proper box
4137 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4138 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4142 if (xi.lt.0) xi=xi+boxxsize
4144 if (yi.lt.0) yi=yi+boxysize
4146 if (zi.lt.0) zi=zi+boxzsize
4148 do iint=1,nscp_gr(i)
4150 do j=iscpstart(i,iint),iscpend(i,iint)
4151 if (itype(j).eq.ntyp1) cycle
4152 itypj=iabs(itype(j))
4153 C Uncomment following three lines for SC-p interactions
4157 C Uncomment following three lines for Ca-p interactions
4162 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4163 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4164 C Condition for being inside the proper box
4165 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4166 c & (xj.lt.((-0.5d0)*boxxsize))) then
4170 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4171 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4172 cC Condition for being inside the proper box
4173 c if ((yj.gt.((0.5d0)*boxysize)).or.
4174 c & (yj.lt.((-0.5d0)*boxysize))) then
4178 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4179 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4180 C Condition for being inside the proper box
4181 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4182 c & (zj.lt.((-0.5d0)*boxzsize))) then
4185 if (xj.lt.0) xj=xj+boxxsize
4187 if (yj.lt.0) yj=yj+boxysize
4189 if (zj.lt.0) zj=zj+boxzsize
4194 rij=xj*xj+yj*yj+zj*zj
4198 if (rij.lt.r0ijsq) then
4199 evdwij=0.25d0*(rij-r0ijsq)**2
4207 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4212 cgrad if (j.lt.i) then
4213 cd write (iout,*) 'j<i'
4214 C Uncomment following three lines for SC-p interactions
4216 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4219 cd write (iout,*) 'j>i'
4221 cgrad ggg(k)=-ggg(k)
4222 C Uncomment following line for SC-p interactions
4223 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4227 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4229 cgrad kstart=min0(i+1,j)
4230 cgrad kend=max0(i-1,j-1)
4231 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4232 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4233 cgrad do k=kstart,kend
4235 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4239 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4240 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4251 C-----------------------------------------------------------------------------
4252 subroutine escp(evdw2,evdw2_14)
4254 C This subroutine calculates the excluded-volume interaction energy between
4255 C peptide-group centers and side chains and its gradient in virtual-bond and
4256 C side-chain vectors.
4258 implicit real*8 (a-h,o-z)
4259 include 'DIMENSIONS'
4260 include 'COMMON.GEO'
4261 include 'COMMON.VAR'
4262 include 'COMMON.LOCAL'
4263 include 'COMMON.CHAIN'
4264 include 'COMMON.DERIV'
4265 include 'COMMON.INTERACT'
4266 include 'COMMON.FFIELD'
4267 include 'COMMON.IOUNITS'
4268 include 'COMMON.CONTROL'
4269 include 'COMMON.SPLITELE'
4273 cd print '(a)','Enter ESCP'
4274 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4278 do i=iatscp_s,iatscp_e
4279 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4281 xi=0.5D0*(c(1,i)+c(1,i+1))
4282 yi=0.5D0*(c(2,i)+c(2,i+1))
4283 zi=0.5D0*(c(3,i)+c(3,i+1))
4285 if (xi.lt.0) xi=xi+boxxsize
4287 if (yi.lt.0) yi=yi+boxysize
4289 if (zi.lt.0) zi=zi+boxzsize
4291 C Return atom into box, boxxsize is size of box in x dimension
4293 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4294 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4295 C Condition for being inside the proper box
4296 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4297 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4301 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4302 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4303 C Condition for being inside the proper box
4304 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4305 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4309 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4310 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4311 C Condition for being inside the proper box
4312 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4313 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4316 do iint=1,nscp_gr(i)
4318 do j=iscpstart(i,iint),iscpend(i,iint)
4319 itypj=iabs(itype(j))
4320 if (itypj.eq.ntyp1) cycle
4321 C Uncomment following three lines for SC-p interactions
4325 C Uncomment following three lines for Ca-p interactions
4330 if (xj.lt.0) xj=xj+boxxsize
4332 if (yj.lt.0) yj=yj+boxysize
4334 if (zj.lt.0) zj=zj+boxzsize
4336 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4337 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4338 C Condition for being inside the proper box
4339 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4340 c & (xj.lt.((-0.5d0)*boxxsize))) then
4344 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4345 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4346 cC Condition for being inside the proper box
4347 c if ((yj.gt.((0.5d0)*boxysize)).or.
4348 c & (yj.lt.((-0.5d0)*boxysize))) then
4352 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4353 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4354 C Condition for being inside the proper box
4355 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4356 c & (zj.lt.((-0.5d0)*boxzsize))) then
4362 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4363 sss=sscale(1.0d0/(dsqrt(rrij)))
4364 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4365 if (sss.gt.0.0d0) then
4367 e1=fac*fac*aad(itypj,iteli)
4368 e2=fac*bad(itypj,iteli)
4369 if (iabs(j-i) .le. 2) then
4372 evdw2_14=evdw2_14+(e1+e2)*sss
4375 evdw2=evdw2+evdwij*sss
4376 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4377 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4380 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4382 fac=-(evdwij+e1)*rrij*sss
4383 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4387 cgrad if (j.lt.i) then
4388 cd write (iout,*) 'j<i'
4389 C Uncomment following three lines for SC-p interactions
4391 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4394 cd write (iout,*) 'j>i'
4396 cgrad ggg(k)=-ggg(k)
4397 C Uncomment following line for SC-p interactions
4398 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4399 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4403 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4405 cgrad kstart=min0(i+1,j)
4406 cgrad kend=max0(i-1,j-1)
4407 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4408 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4409 cgrad do k=kstart,kend
4411 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4415 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4416 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4418 endif !endif for sscale cutoff
4428 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4429 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4430 gradx_scp(j,i)=expon*gradx_scp(j,i)
4433 C******************************************************************************
4437 C To save time the factor EXPON has been extracted from ALL components
4438 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4441 C******************************************************************************
4444 C--------------------------------------------------------------------------
4445 subroutine edis(ehpb)
4447 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4449 implicit real*8 (a-h,o-z)
4450 include 'DIMENSIONS'
4451 include 'COMMON.SBRIDGE'
4452 include 'COMMON.CHAIN'
4453 include 'COMMON.DERIV'
4454 include 'COMMON.VAR'
4455 include 'COMMON.INTERACT'
4456 include 'COMMON.IOUNITS'
4459 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4460 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4461 if (link_end.eq.0) return
4462 do i=link_start,link_end
4463 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4464 C CA-CA distance used in regularization of structure.
4467 C iii and jjj point to the residues for which the distance is assigned.
4468 if (ii.gt.nres) then
4475 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4476 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4477 C distance and angle dependent SS bond potential.
4478 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4479 & iabs(itype(jjj)).eq.1) then
4480 call ssbond_ene(iii,jjj,eij)
4482 cd write (iout,*) "eij",eij
4484 C Calculate the distance between the two points and its difference from the
4488 C Get the force constant corresponding to this distance.
4490 C Calculate the contribution to energy.
4491 ehpb=ehpb+waga*rdis*rdis
4493 C Evaluate gradient.
4496 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4497 cd & ' waga=',waga,' fac=',fac
4499 ggg(j)=fac*(c(j,jj)-c(j,ii))
4501 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4502 C If this is a SC-SC distance, we need to calculate the contributions to the
4503 C Cartesian gradient in the SC vectors (ghpbx).
4506 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4507 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4510 cgrad do j=iii,jjj-1
4512 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4516 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4517 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4524 C--------------------------------------------------------------------------
4525 subroutine ssbond_ene(i,j,eij)
4527 C Calculate the distance and angle dependent SS-bond potential energy
4528 C using a free-energy function derived based on RHF/6-31G** ab initio
4529 C calculations of diethyl disulfide.
4531 C A. Liwo and U. Kozlowska, 11/24/03
4533 implicit real*8 (a-h,o-z)
4534 include 'DIMENSIONS'
4535 include 'COMMON.SBRIDGE'
4536 include 'COMMON.CHAIN'
4537 include 'COMMON.DERIV'
4538 include 'COMMON.LOCAL'
4539 include 'COMMON.INTERACT'
4540 include 'COMMON.VAR'
4541 include 'COMMON.IOUNITS'
4542 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4543 itypi=iabs(itype(i))
4547 dxi=dc_norm(1,nres+i)
4548 dyi=dc_norm(2,nres+i)
4549 dzi=dc_norm(3,nres+i)
4550 c dsci_inv=dsc_inv(itypi)
4551 dsci_inv=vbld_inv(nres+i)
4552 itypj=iabs(itype(j))
4553 c dscj_inv=dsc_inv(itypj)
4554 dscj_inv=vbld_inv(nres+j)
4558 dxj=dc_norm(1,nres+j)
4559 dyj=dc_norm(2,nres+j)
4560 dzj=dc_norm(3,nres+j)
4561 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4566 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4567 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4568 om12=dxi*dxj+dyi*dyj+dzi*dzj
4570 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4571 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4577 deltat12=om2-om1+2.0d0
4579 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4580 & +akct*deltad*deltat12
4581 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4582 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4583 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4584 c & " deltat12",deltat12," eij",eij
4585 ed=2*akcm*deltad+akct*deltat12
4587 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4588 eom1=-2*akth*deltat1-pom1-om2*pom2
4589 eom2= 2*akth*deltat2+pom1-om1*pom2
4592 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4593 ghpbx(k,i)=ghpbx(k,i)-ggk
4594 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4595 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4596 ghpbx(k,j)=ghpbx(k,j)+ggk
4597 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4598 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4599 ghpbc(k,i)=ghpbc(k,i)-ggk
4600 ghpbc(k,j)=ghpbc(k,j)+ggk
4603 C Calculate the components of the gradient in DC and X
4607 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4612 C--------------------------------------------------------------------------
4613 subroutine ebond(estr)
4615 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4617 implicit real*8 (a-h,o-z)
4618 include 'DIMENSIONS'
4619 include 'COMMON.LOCAL'
4620 include 'COMMON.GEO'
4621 include 'COMMON.INTERACT'
4622 include 'COMMON.DERIV'
4623 include 'COMMON.VAR'
4624 include 'COMMON.CHAIN'
4625 include 'COMMON.IOUNITS'
4626 include 'COMMON.NAMES'
4627 include 'COMMON.FFIELD'
4628 include 'COMMON.CONTROL'
4629 include 'COMMON.SETUP'
4630 double precision u(3),ud(3)
4633 do i=ibondp_start,ibondp_end
4634 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4635 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4637 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4638 c & *dc(j,i-1)/vbld(i)
4640 c if (energy_dec) write(iout,*)
4641 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4643 C Checking if it involves dummy (NH3+ or COO-) group
4644 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4645 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
4646 diff = vbld(i)-vbldpDUM
4648 C NO vbldp0 is the equlibrium lenght of spring for peptide group
4649 diff = vbld(i)-vbldp0
4651 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
4652 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4655 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4657 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4660 estr=0.5d0*AKP*estr+estr1
4662 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4664 do i=ibond_start,ibond_end
4666 if (iti.ne.10 .and. iti.ne.ntyp1) then
4669 diff=vbld(i+nres)-vbldsc0(1,iti)
4670 if (energy_dec) write (iout,*)
4671 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4672 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4673 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4675 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4679 diff=vbld(i+nres)-vbldsc0(j,iti)
4680 ud(j)=aksc(j,iti)*diff
4681 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4695 uprod2=uprod2*u(k)*u(k)
4699 usumsqder=usumsqder+ud(j)*uprod2
4701 estr=estr+uprod/usum
4703 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4711 C--------------------------------------------------------------------------
4712 subroutine ebend(etheta)
4714 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4715 C angles gamma and its derivatives in consecutive thetas and gammas.
4717 implicit real*8 (a-h,o-z)
4718 include 'DIMENSIONS'
4719 include 'COMMON.LOCAL'
4720 include 'COMMON.GEO'
4721 include 'COMMON.INTERACT'
4722 include 'COMMON.DERIV'
4723 include 'COMMON.VAR'
4724 include 'COMMON.CHAIN'
4725 include 'COMMON.IOUNITS'
4726 include 'COMMON.NAMES'
4727 include 'COMMON.FFIELD'
4728 include 'COMMON.CONTROL'
4729 common /calcthet/ term1,term2,termm,diffak,ratak,
4730 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4731 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4732 double precision y(2),z(2)
4734 c time11=dexp(-2*time)
4737 c write (*,'(a,i2)') 'EBEND ICG=',icg
4738 do i=ithet_start,ithet_end
4739 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4740 & .or.itype(i).eq.ntyp1) cycle
4741 C Zero the energy function and its derivative at 0 or pi.
4742 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4744 ichir1=isign(1,itype(i-2))
4745 ichir2=isign(1,itype(i))
4746 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4747 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4748 if (itype(i-1).eq.10) then
4749 itype1=isign(10,itype(i-2))
4750 ichir11=isign(1,itype(i-2))
4751 ichir12=isign(1,itype(i-2))
4752 itype2=isign(10,itype(i))
4753 ichir21=isign(1,itype(i))
4754 ichir22=isign(1,itype(i))
4757 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4760 if (phii.ne.phii) phii=150.0
4770 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4773 if (phii1.ne.phii1) phii1=150.0
4785 C Calculate the "mean" value of theta from the part of the distribution
4786 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4787 C In following comments this theta will be referred to as t_c.
4788 thet_pred_mean=0.0d0
4790 athetk=athet(k,it,ichir1,ichir2)
4791 bthetk=bthet(k,it,ichir1,ichir2)
4793 athetk=athet(k,itype1,ichir11,ichir12)
4794 bthetk=bthet(k,itype2,ichir21,ichir22)
4796 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4797 c write(iout,*) 'chuj tu', y(k),z(k)
4799 dthett=thet_pred_mean*ssd
4800 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4801 C Derivatives of the "mean" values in gamma1 and gamma2.
4802 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4803 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4804 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4805 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4807 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4808 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4809 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4810 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4812 if (theta(i).gt.pi-delta) then
4813 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4815 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4816 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4817 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4819 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4821 else if (theta(i).lt.delta) then
4822 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4823 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4824 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4826 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4827 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4830 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4833 etheta=etheta+ethetai
4834 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4835 & 'ebend',i,ethetai,theta(i),itype(i)
4836 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4837 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4838 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
4840 C Ufff.... We've done all this!!!
4843 C---------------------------------------------------------------------------
4844 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4846 implicit real*8 (a-h,o-z)
4847 include 'DIMENSIONS'
4848 include 'COMMON.LOCAL'
4849 include 'COMMON.IOUNITS'
4850 common /calcthet/ term1,term2,termm,diffak,ratak,
4851 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4852 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4853 C Calculate the contributions to both Gaussian lobes.
4854 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4855 C The "polynomial part" of the "standard deviation" of this part of
4856 C the distributioni.
4857 ccc write (iout,*) thetai,thet_pred_mean
4860 sig=sig*thet_pred_mean+polthet(j,it)
4862 C Derivative of the "interior part" of the "standard deviation of the"
4863 C gamma-dependent Gaussian lobe in t_c.
4864 sigtc=3*polthet(3,it)
4866 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4869 C Set the parameters of both Gaussian lobes of the distribution.
4870 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4871 fac=sig*sig+sigc0(it)
4874 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4875 sigsqtc=-4.0D0*sigcsq*sigtc
4876 c print *,i,sig,sigtc,sigsqtc
4877 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4878 sigtc=-sigtc/(fac*fac)
4879 C Following variable is sigma(t_c)**(-2)
4880 sigcsq=sigcsq*sigcsq
4882 sig0inv=1.0D0/sig0i**2
4883 delthec=thetai-thet_pred_mean
4884 delthe0=thetai-theta0i
4885 term1=-0.5D0*sigcsq*delthec*delthec
4886 term2=-0.5D0*sig0inv*delthe0*delthe0
4887 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
4888 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4889 C NaNs in taking the logarithm. We extract the largest exponent which is added
4890 C to the energy (this being the log of the distribution) at the end of energy
4891 C term evaluation for this virtual-bond angle.
4892 if (term1.gt.term2) then
4894 term2=dexp(term2-termm)
4898 term1=dexp(term1-termm)
4901 C The ratio between the gamma-independent and gamma-dependent lobes of
4902 C the distribution is a Gaussian function of thet_pred_mean too.
4903 diffak=gthet(2,it)-thet_pred_mean
4904 ratak=diffak/gthet(3,it)**2
4905 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4906 C Let's differentiate it in thet_pred_mean NOW.
4908 C Now put together the distribution terms to make complete distribution.
4909 termexp=term1+ak*term2
4910 termpre=sigc+ak*sig0i
4911 C Contribution of the bending energy from this theta is just the -log of
4912 C the sum of the contributions from the two lobes and the pre-exponential
4913 C factor. Simple enough, isn't it?
4914 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4915 C write (iout,*) 'termexp',termexp,termm,termpre,i
4916 C NOW the derivatives!!!
4917 C 6/6/97 Take into account the deformation.
4918 E_theta=(delthec*sigcsq*term1
4919 & +ak*delthe0*sig0inv*term2)/termexp
4920 E_tc=((sigtc+aktc*sig0i)/termpre
4921 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4922 & aktc*term2)/termexp)
4925 c-----------------------------------------------------------------------------
4926 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4927 implicit real*8 (a-h,o-z)
4928 include 'DIMENSIONS'
4929 include 'COMMON.LOCAL'
4930 include 'COMMON.IOUNITS'
4931 common /calcthet/ term1,term2,termm,diffak,ratak,
4932 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4933 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4934 delthec=thetai-thet_pred_mean
4935 delthe0=thetai-theta0i
4936 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4937 t3 = thetai-thet_pred_mean
4941 t14 = t12+t6*sigsqtc
4943 t21 = thetai-theta0i
4949 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4950 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4951 & *(-t12*t9-ak*sig0inv*t27)
4955 C--------------------------------------------------------------------------
4956 subroutine ebend(etheta)
4958 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4959 C angles gamma and its derivatives in consecutive thetas and gammas.
4960 C ab initio-derived potentials from
4961 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4963 implicit real*8 (a-h,o-z)
4964 include 'DIMENSIONS'
4965 include 'COMMON.LOCAL'
4966 include 'COMMON.GEO'
4967 include 'COMMON.INTERACT'
4968 include 'COMMON.DERIV'
4969 include 'COMMON.VAR'
4970 include 'COMMON.CHAIN'
4971 include 'COMMON.IOUNITS'
4972 include 'COMMON.NAMES'
4973 include 'COMMON.FFIELD'
4974 include 'COMMON.CONTROL'
4975 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4976 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4977 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4978 & sinph1ph2(maxdouble,maxdouble)
4979 logical lprn /.false./, lprn1 /.false./
4981 do i=ithet_start,ithet_end
4982 c print *,i,itype(i-1),itype(i),itype(i-2)
4983 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4984 & .or.itype(i).eq.ntyp1) cycle
4985 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
4987 if (iabs(itype(i+1)).eq.20) iblock=2
4988 if (iabs(itype(i+1)).ne.20) iblock=1
4992 theti2=0.5d0*theta(i)
4993 ityp2=ithetyp((itype(i-1)))
4995 coskt(k)=dcos(k*theti2)
4996 sinkt(k)=dsin(k*theti2)
4998 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5001 if (phii.ne.phii) phii=150.0
5005 ityp1=ithetyp((itype(i-2)))
5006 C propagation of chirality for glycine type
5008 cosph1(k)=dcos(k*phii)
5009 sinph1(k)=dsin(k*phii)
5019 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5022 if (phii1.ne.phii1) phii1=150.0
5027 ityp3=ithetyp((itype(i)))
5029 cosph2(k)=dcos(k*phii1)
5030 sinph2(k)=dsin(k*phii1)
5040 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5043 ccl=cosph1(l)*cosph2(k-l)
5044 ssl=sinph1(l)*sinph2(k-l)
5045 scl=sinph1(l)*cosph2(k-l)
5046 csl=cosph1(l)*sinph2(k-l)
5047 cosph1ph2(l,k)=ccl-ssl
5048 cosph1ph2(k,l)=ccl+ssl
5049 sinph1ph2(l,k)=scl+csl
5050 sinph1ph2(k,l)=scl-csl
5054 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5055 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5056 write (iout,*) "coskt and sinkt"
5058 write (iout,*) k,coskt(k),sinkt(k)
5062 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5063 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5066 & write (iout,*) "k",k,"
5067 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5068 & " ethetai",ethetai
5071 write (iout,*) "cosph and sinph"
5073 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5075 write (iout,*) "cosph1ph2 and sinph2ph2"
5078 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5079 & sinph1ph2(l,k),sinph1ph2(k,l)
5082 write(iout,*) "ethetai",ethetai
5086 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5087 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5088 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5089 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5090 ethetai=ethetai+sinkt(m)*aux
5091 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5092 dephii=dephii+k*sinkt(m)*(
5093 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5094 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5095 dephii1=dephii1+k*sinkt(m)*(
5096 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5097 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5099 & write (iout,*) "m",m," k",k," bbthet",
5100 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5101 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5102 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5103 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5107 & write(iout,*) "ethetai",ethetai
5111 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5112 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5113 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5114 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5115 ethetai=ethetai+sinkt(m)*aux
5116 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5117 dephii=dephii+l*sinkt(m)*(
5118 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5119 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5120 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5121 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5122 dephii1=dephii1+(k-l)*sinkt(m)*(
5123 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5124 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5125 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5126 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5128 write (iout,*) "m",m," k",k," l",l," ffthet",
5129 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5130 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5131 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5132 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5133 & " ethetai",ethetai
5134 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5135 & cosph1ph2(k,l)*sinkt(m),
5136 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5144 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5145 & i,theta(i)*rad2deg,phii*rad2deg,
5146 & phii1*rad2deg,ethetai
5148 etheta=etheta+ethetai
5149 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5150 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5151 gloc(nphi+i-2,icg)=wang*dethetai+ gloc(nphi+i-2,icg)
5157 c-----------------------------------------------------------------------------
5158 subroutine esc(escloc)
5159 C Calculate the local energy of a side chain and its derivatives in the
5160 C corresponding virtual-bond valence angles THETA and the spherical angles
5162 implicit real*8 (a-h,o-z)
5163 include 'DIMENSIONS'
5164 include 'COMMON.GEO'
5165 include 'COMMON.LOCAL'
5166 include 'COMMON.VAR'
5167 include 'COMMON.INTERACT'
5168 include 'COMMON.DERIV'
5169 include 'COMMON.CHAIN'
5170 include 'COMMON.IOUNITS'
5171 include 'COMMON.NAMES'
5172 include 'COMMON.FFIELD'
5173 include 'COMMON.CONTROL'
5174 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5175 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5176 common /sccalc/ time11,time12,time112,theti,it,nlobit
5179 c write (iout,'(a)') 'ESC'
5180 do i=loc_start,loc_end
5182 if (it.eq.ntyp1) cycle
5183 if (it.eq.10) goto 1
5184 nlobit=nlob(iabs(it))
5185 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5186 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5187 theti=theta(i+1)-pipol
5192 if (x(2).gt.pi-delta) then
5196 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5198 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5199 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5201 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5202 & ddersc0(1),dersc(1))
5203 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5204 & ddersc0(3),dersc(3))
5206 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5208 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5209 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5210 & dersc0(2),esclocbi,dersc02)
5211 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5213 call splinthet(x(2),0.5d0*delta,ss,ssd)
5218 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5220 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5221 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5223 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5225 c write (iout,*) escloci
5226 else if (x(2).lt.delta) then
5230 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5232 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5233 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5235 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5236 & ddersc0(1),dersc(1))
5237 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5238 & ddersc0(3),dersc(3))
5240 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5242 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5243 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5244 & dersc0(2),esclocbi,dersc02)
5245 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5250 call splinthet(x(2),0.5d0*delta,ss,ssd)
5252 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5254 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5255 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5257 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5258 c write (iout,*) escloci
5260 call enesc(x,escloci,dersc,ddummy,.false.)
5263 escloc=escloc+escloci
5264 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5265 & 'escloc',i,escloci
5266 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5268 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5270 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5271 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5276 C---------------------------------------------------------------------------
5277 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5278 implicit real*8 (a-h,o-z)
5279 include 'DIMENSIONS'
5280 include 'COMMON.GEO'
5281 include 'COMMON.LOCAL'
5282 include 'COMMON.IOUNITS'
5283 common /sccalc/ time11,time12,time112,theti,it,nlobit
5284 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5285 double precision contr(maxlob,-1:1)
5287 c write (iout,*) 'it=',it,' nlobit=',nlobit
5291 if (mixed) ddersc(j)=0.0d0
5295 C Because of periodicity of the dependence of the SC energy in omega we have
5296 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5297 C To avoid underflows, first compute & store the exponents.
5305 z(k)=x(k)-censc(k,j,it)
5310 Axk=Axk+gaussc(l,k,j,it)*z(l)
5316 expfac=expfac+Ax(k,j,iii)*z(k)
5324 C As in the case of ebend, we want to avoid underflows in exponentiation and
5325 C subsequent NaNs and INFs in energy calculation.
5326 C Find the largest exponent
5330 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5334 cd print *,'it=',it,' emin=',emin
5336 C Compute the contribution to SC energy and derivatives
5341 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5342 if(adexp.ne.adexp) adexp=1.0
5345 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5347 cd print *,'j=',j,' expfac=',expfac
5348 escloc_i=escloc_i+expfac
5350 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5354 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5355 & +gaussc(k,2,j,it))*expfac
5362 dersc(1)=dersc(1)/cos(theti)**2
5363 ddersc(1)=ddersc(1)/cos(theti)**2
5366 escloci=-(dlog(escloc_i)-emin)
5368 dersc(j)=dersc(j)/escloc_i
5372 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5377 C------------------------------------------------------------------------------
5378 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5379 implicit real*8 (a-h,o-z)
5380 include 'DIMENSIONS'
5381 include 'COMMON.GEO'
5382 include 'COMMON.LOCAL'
5383 include 'COMMON.IOUNITS'
5384 common /sccalc/ time11,time12,time112,theti,it,nlobit
5385 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5386 double precision contr(maxlob)
5397 z(k)=x(k)-censc(k,j,it)
5403 Axk=Axk+gaussc(l,k,j,it)*z(l)
5409 expfac=expfac+Ax(k,j)*z(k)
5414 C As in the case of ebend, we want to avoid underflows in exponentiation and
5415 C subsequent NaNs and INFs in energy calculation.
5416 C Find the largest exponent
5419 if (emin.gt.contr(j)) emin=contr(j)
5423 C Compute the contribution to SC energy and derivatives
5427 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5428 escloc_i=escloc_i+expfac
5430 dersc(k)=dersc(k)+Ax(k,j)*expfac
5432 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5433 & +gaussc(1,2,j,it))*expfac
5437 dersc(1)=dersc(1)/cos(theti)**2
5438 dersc12=dersc12/cos(theti)**2
5439 escloci=-(dlog(escloc_i)-emin)
5441 dersc(j)=dersc(j)/escloc_i
5443 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5447 c----------------------------------------------------------------------------------
5448 subroutine esc(escloc)
5449 C Calculate the local energy of a side chain and its derivatives in the
5450 C corresponding virtual-bond valence angles THETA and the spherical angles
5451 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5452 C added by Urszula Kozlowska. 07/11/2007
5454 implicit real*8 (a-h,o-z)
5455 include 'DIMENSIONS'
5456 include 'COMMON.GEO'
5457 include 'COMMON.LOCAL'
5458 include 'COMMON.VAR'
5459 include 'COMMON.SCROT'
5460 include 'COMMON.INTERACT'
5461 include 'COMMON.DERIV'
5462 include 'COMMON.CHAIN'
5463 include 'COMMON.IOUNITS'
5464 include 'COMMON.NAMES'
5465 include 'COMMON.FFIELD'
5466 include 'COMMON.CONTROL'
5467 include 'COMMON.VECTORS'
5468 double precision x_prime(3),y_prime(3),z_prime(3)
5469 & , sumene,dsc_i,dp2_i,x(65),
5470 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5471 & de_dxx,de_dyy,de_dzz,de_dt
5472 double precision s1_t,s1_6_t,s2_t,s2_6_t
5474 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5475 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5476 & dt_dCi(3),dt_dCi1(3)
5477 common /sccalc/ time11,time12,time112,theti,it,nlobit
5480 do i=loc_start,loc_end
5481 if (itype(i).eq.ntyp1) cycle
5482 costtab(i+1) =dcos(theta(i+1))
5483 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5484 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5485 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5486 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5487 cosfac=dsqrt(cosfac2)
5488 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5489 sinfac=dsqrt(sinfac2)
5491 if (it.eq.10) goto 1
5493 C Compute the axes of tghe local cartesian coordinates system; store in
5494 c x_prime, y_prime and z_prime
5501 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5502 C & dc_norm(3,i+nres)
5504 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5505 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5508 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5511 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5512 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5513 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5514 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5515 c & " xy",scalar(x_prime(1),y_prime(1)),
5516 c & " xz",scalar(x_prime(1),z_prime(1)),
5517 c & " yy",scalar(y_prime(1),y_prime(1)),
5518 c & " yz",scalar(y_prime(1),z_prime(1)),
5519 c & " zz",scalar(z_prime(1),z_prime(1))
5521 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5522 C to local coordinate system. Store in xx, yy, zz.
5528 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5529 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5530 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5537 C Compute the energy of the ith side cbain
5539 c write (2,*) "xx",xx," yy",yy," zz",zz
5542 x(j) = sc_parmin(j,it)
5545 Cc diagnostics - remove later
5547 yy1 = dsin(alph(2))*dcos(omeg(2))
5548 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5549 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5550 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5552 C," --- ", xx_w,yy_w,zz_w
5555 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5556 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5558 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5559 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5561 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5562 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5563 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5564 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5565 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5567 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5568 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5569 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5570 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5571 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5573 dsc_i = 0.743d0+x(61)
5575 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5576 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5577 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5578 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5579 s1=(1+x(63))/(0.1d0 + dscp1)
5580 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5581 s2=(1+x(65))/(0.1d0 + dscp2)
5582 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5583 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5584 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5585 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5587 c & dscp1,dscp2,sumene
5588 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5589 escloc = escloc + sumene
5590 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5595 C This section to check the numerical derivatives of the energy of ith side
5596 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5597 C #define DEBUG in the code to turn it on.
5599 write (2,*) "sumene =",sumene
5603 write (2,*) xx,yy,zz
5604 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5605 de_dxx_num=(sumenep-sumene)/aincr
5607 write (2,*) "xx+ sumene from enesc=",sumenep
5610 write (2,*) xx,yy,zz
5611 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5612 de_dyy_num=(sumenep-sumene)/aincr
5614 write (2,*) "yy+ sumene from enesc=",sumenep
5617 write (2,*) xx,yy,zz
5618 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5619 de_dzz_num=(sumenep-sumene)/aincr
5621 write (2,*) "zz+ sumene from enesc=",sumenep
5622 costsave=cost2tab(i+1)
5623 sintsave=sint2tab(i+1)
5624 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5625 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5626 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5627 de_dt_num=(sumenep-sumene)/aincr
5628 write (2,*) " t+ sumene from enesc=",sumenep
5629 cost2tab(i+1)=costsave
5630 sint2tab(i+1)=sintsave
5631 C End of diagnostics section.
5634 C Compute the gradient of esc
5636 c zz=zz*dsign(1.0,dfloat(itype(i)))
5637 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5638 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5639 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5640 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5641 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5642 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5643 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5644 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5645 pom1=(sumene3*sint2tab(i+1)+sumene1)
5646 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5647 pom2=(sumene4*cost2tab(i+1)+sumene2)
5648 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5649 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5650 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5651 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5653 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5654 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5655 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5657 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5658 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5659 & +(pom1+pom2)*pom_dx
5661 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5664 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5665 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5666 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5668 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5669 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5670 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5671 & +x(59)*zz**2 +x(60)*xx*zz
5672 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5673 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5674 & +(pom1-pom2)*pom_dy
5676 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5679 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5680 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5681 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5682 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5683 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5684 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5685 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5686 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5688 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5691 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5692 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5693 & +pom1*pom_dt1+pom2*pom_dt2
5695 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5700 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5701 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5702 cosfac2xx=cosfac2*xx
5703 sinfac2yy=sinfac2*yy
5705 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5707 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5709 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5710 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5711 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5712 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5713 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5714 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5715 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5716 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5717 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5718 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5722 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5723 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5724 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5725 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5728 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5729 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5730 dZZ_XYZ(k)=vbld_inv(i+nres)*
5731 & (z_prime(k)-zz*dC_norm(k,i+nres))
5733 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5734 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5738 dXX_Ctab(k,i)=dXX_Ci(k)
5739 dXX_C1tab(k,i)=dXX_Ci1(k)
5740 dYY_Ctab(k,i)=dYY_Ci(k)
5741 dYY_C1tab(k,i)=dYY_Ci1(k)
5742 dZZ_Ctab(k,i)=dZZ_Ci(k)
5743 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5744 dXX_XYZtab(k,i)=dXX_XYZ(k)
5745 dYY_XYZtab(k,i)=dYY_XYZ(k)
5746 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5750 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5751 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5752 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5753 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5754 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5756 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5757 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5758 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5759 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5760 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5761 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5762 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5763 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5765 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5766 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5768 C to check gradient call subroutine check_grad
5774 c------------------------------------------------------------------------------
5775 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5777 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5778 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5779 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5780 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5782 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5783 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5785 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5786 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5787 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5788 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5789 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5791 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5792 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5793 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5794 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5795 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5797 dsc_i = 0.743d0+x(61)
5799 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5800 & *(xx*cost2+yy*sint2))
5801 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5802 & *(xx*cost2-yy*sint2))
5803 s1=(1+x(63))/(0.1d0 + dscp1)
5804 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5805 s2=(1+x(65))/(0.1d0 + dscp2)
5806 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5807 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5808 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5813 c------------------------------------------------------------------------------
5814 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5816 C This procedure calculates two-body contact function g(rij) and its derivative:
5819 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5822 C where x=(rij-r0ij)/delta
5824 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5827 double precision rij,r0ij,eps0ij,fcont,fprimcont
5828 double precision x,x2,x4,delta
5832 if (x.lt.-1.0D0) then
5835 else if (x.le.1.0D0) then
5838 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5839 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5846 c------------------------------------------------------------------------------
5847 subroutine splinthet(theti,delta,ss,ssder)
5848 implicit real*8 (a-h,o-z)
5849 include 'DIMENSIONS'
5850 include 'COMMON.VAR'
5851 include 'COMMON.GEO'
5854 if (theti.gt.pipol) then
5855 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5857 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5862 c------------------------------------------------------------------------------
5863 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5865 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5866 double precision ksi,ksi2,ksi3,a1,a2,a3
5867 a1=fprim0*delta/(f1-f0)
5873 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5874 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5877 c------------------------------------------------------------------------------
5878 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5880 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5881 double precision ksi,ksi2,ksi3,a1,a2,a3
5886 a2=3*(f1x-f0x)-2*fprim0x*delta
5887 a3=fprim0x*delta-2*(f1x-f0x)
5888 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5891 C-----------------------------------------------------------------------------
5893 C-----------------------------------------------------------------------------
5894 subroutine etor(etors,edihcnstr)
5895 implicit real*8 (a-h,o-z)
5896 include 'DIMENSIONS'
5897 include 'COMMON.VAR'
5898 include 'COMMON.GEO'
5899 include 'COMMON.LOCAL'
5900 include 'COMMON.TORSION'
5901 include 'COMMON.INTERACT'
5902 include 'COMMON.DERIV'
5903 include 'COMMON.CHAIN'
5904 include 'COMMON.NAMES'
5905 include 'COMMON.IOUNITS'
5906 include 'COMMON.FFIELD'
5907 include 'COMMON.TORCNSTR'
5908 include 'COMMON.CONTROL'
5910 C Set lprn=.true. for debugging
5914 do i=iphi_start,iphi_end
5916 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5917 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5918 itori=itortyp(itype(i-2))
5919 itori1=itortyp(itype(i-1))
5922 C Proline-Proline pair is a special case...
5923 if (itori.eq.3 .and. itori1.eq.3) then
5924 if (phii.gt.-dwapi3) then
5926 fac=1.0D0/(1.0D0-cosphi)
5927 etorsi=v1(1,3,3)*fac
5928 etorsi=etorsi+etorsi
5929 etors=etors+etorsi-v1(1,3,3)
5930 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5931 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5934 v1ij=v1(j+1,itori,itori1)
5935 v2ij=v2(j+1,itori,itori1)
5938 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5939 if (energy_dec) etors_ii=etors_ii+
5940 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5941 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5945 v1ij=v1(j,itori,itori1)
5946 v2ij=v2(j,itori,itori1)
5949 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5950 if (energy_dec) etors_ii=etors_ii+
5951 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5952 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5955 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5958 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5959 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5960 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5961 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5962 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5964 ! 6/20/98 - dihedral angle constraints
5967 itori=idih_constr(i)
5970 if (difi.gt.drange(i)) then
5972 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5973 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5974 else if (difi.lt.-drange(i)) then
5976 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5977 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5979 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5980 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5982 ! write (iout,*) 'edihcnstr',edihcnstr
5985 c------------------------------------------------------------------------------
5986 subroutine etor_d(etors_d)
5990 c----------------------------------------------------------------------------
5992 subroutine etor(etors,edihcnstr)
5993 implicit real*8 (a-h,o-z)
5994 include 'DIMENSIONS'
5995 include 'COMMON.VAR'
5996 include 'COMMON.GEO'
5997 include 'COMMON.LOCAL'
5998 include 'COMMON.TORSION'
5999 include 'COMMON.INTERACT'
6000 include 'COMMON.DERIV'
6001 include 'COMMON.CHAIN'
6002 include 'COMMON.NAMES'
6003 include 'COMMON.IOUNITS'
6004 include 'COMMON.FFIELD'
6005 include 'COMMON.TORCNSTR'
6006 include 'COMMON.CONTROL'
6008 C Set lprn=.true. for debugging
6012 do i=iphi_start,iphi_end
6013 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6014 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6015 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6016 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6017 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6018 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6019 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6020 C For introducing the NH3+ and COO- group please check the etor_d for reference
6023 if (iabs(itype(i)).eq.20) then
6028 itori=itortyp(itype(i-2))
6029 itori1=itortyp(itype(i-1))
6032 C Regular cosine and sine terms
6033 do j=1,nterm(itori,itori1,iblock)
6034 v1ij=v1(j,itori,itori1,iblock)
6035 v2ij=v2(j,itori,itori1,iblock)
6038 etors=etors+v1ij*cosphi+v2ij*sinphi
6039 if (energy_dec) etors_ii=etors_ii+
6040 & v1ij*cosphi+v2ij*sinphi
6041 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6045 C E = SUM ----------------------------------- - v1
6046 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6048 cosphi=dcos(0.5d0*phii)
6049 sinphi=dsin(0.5d0*phii)
6050 do j=1,nlor(itori,itori1,iblock)
6051 vl1ij=vlor1(j,itori,itori1)
6052 vl2ij=vlor2(j,itori,itori1)
6053 vl3ij=vlor3(j,itori,itori1)
6054 pom=vl2ij*cosphi+vl3ij*sinphi
6055 pom1=1.0d0/(pom*pom+1.0d0)
6056 etors=etors+vl1ij*pom1
6057 if (energy_dec) etors_ii=etors_ii+
6060 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6062 C Subtract the constant term
6063 etors=etors-v0(itori,itori1,iblock)
6064 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6065 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6067 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6068 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6069 & (v1(j,itori,itori1,iblock),j=1,6),
6070 & (v2(j,itori,itori1,iblock),j=1,6)
6071 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6072 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6074 ! 6/20/98 - dihedral angle constraints
6076 c do i=1,ndih_constr
6077 do i=idihconstr_start,idihconstr_end
6078 itori=idih_constr(i)
6080 difi=pinorm(phii-phi0(i))
6081 if (difi.gt.drange(i)) then
6083 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6084 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6085 else if (difi.lt.-drange(i)) then
6087 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6088 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6092 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6093 cd & rad2deg*phi0(i), rad2deg*drange(i),
6094 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6096 cd write (iout,*) 'edihcnstr',edihcnstr
6099 c----------------------------------------------------------------------------
6100 subroutine etor_d(etors_d)
6101 C 6/23/01 Compute double torsional energy
6102 implicit real*8 (a-h,o-z)
6103 include 'DIMENSIONS'
6104 include 'COMMON.VAR'
6105 include 'COMMON.GEO'
6106 include 'COMMON.LOCAL'
6107 include 'COMMON.TORSION'
6108 include 'COMMON.INTERACT'
6109 include 'COMMON.DERIV'
6110 include 'COMMON.CHAIN'
6111 include 'COMMON.NAMES'
6112 include 'COMMON.IOUNITS'
6113 include 'COMMON.FFIELD'
6114 include 'COMMON.TORCNSTR'
6116 C Set lprn=.true. for debugging
6120 c write(iout,*) "a tu??"
6121 do i=iphid_start,iphid_end
6122 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6123 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6124 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6125 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6126 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6127 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6128 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6129 & (itype(i+1).eq.ntyp1)) cycle
6130 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6131 itori=itortyp(itype(i-2))
6132 itori1=itortyp(itype(i-1))
6133 itori2=itortyp(itype(i))
6139 if (iabs(itype(i+1)).eq.20) iblock=2
6140 C Iblock=2 Proline type
6141 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6142 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6143 C if (itype(i+1).eq.ntyp1) iblock=3
6144 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6145 C IS or IS NOT need for this
6146 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6147 C is (itype(i-3).eq.ntyp1) ntblock=2
6148 C ntblock is N-terminal blocking group
6150 C Regular cosine and sine terms
6151 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6152 C Example of changes for NH3+ blocking group
6153 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6154 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6155 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6156 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6157 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6158 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6159 cosphi1=dcos(j*phii)
6160 sinphi1=dsin(j*phii)
6161 cosphi2=dcos(j*phii1)
6162 sinphi2=dsin(j*phii1)
6163 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6164 & v2cij*cosphi2+v2sij*sinphi2
6165 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6166 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6168 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6170 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6171 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6172 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6173 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6174 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6175 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6176 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6177 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6178 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6179 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6180 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6181 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6182 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6183 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6186 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6187 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6192 c------------------------------------------------------------------------------
6193 subroutine eback_sc_corr(esccor)
6194 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6195 c conformational states; temporarily implemented as differences
6196 c between UNRES torsional potentials (dependent on three types of
6197 c residues) and the torsional potentials dependent on all 20 types
6198 c of residues computed from AM1 energy surfaces of terminally-blocked
6199 c amino-acid residues.
6200 implicit real*8 (a-h,o-z)
6201 include 'DIMENSIONS'
6202 include 'COMMON.VAR'
6203 include 'COMMON.GEO'
6204 include 'COMMON.LOCAL'
6205 include 'COMMON.TORSION'
6206 include 'COMMON.SCCOR'
6207 include 'COMMON.INTERACT'
6208 include 'COMMON.DERIV'
6209 include 'COMMON.CHAIN'
6210 include 'COMMON.NAMES'
6211 include 'COMMON.IOUNITS'
6212 include 'COMMON.FFIELD'
6213 include 'COMMON.CONTROL'
6215 C Set lprn=.true. for debugging
6218 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6220 do i=itau_start,itau_end
6221 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6223 isccori=isccortyp(itype(i-2))
6224 isccori1=isccortyp(itype(i-1))
6225 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6227 do intertyp=1,3 !intertyp
6228 cc Added 09 May 2012 (Adasko)
6229 cc Intertyp means interaction type of backbone mainchain correlation:
6230 c 1 = SC...Ca...Ca...Ca
6231 c 2 = Ca...Ca...Ca...SC
6232 c 3 = SC...Ca...Ca...SCi
6234 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6235 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6236 & (itype(i-1).eq.ntyp1)))
6237 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6238 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6239 & .or.(itype(i).eq.ntyp1)))
6240 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6241 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6242 & (itype(i-3).eq.ntyp1)))) cycle
6243 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6244 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6246 do j=1,nterm_sccor(isccori,isccori1)
6247 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6248 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6249 cosphi=dcos(j*tauangle(intertyp,i))
6250 sinphi=dsin(j*tauangle(intertyp,i))
6251 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6252 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6254 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6255 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6257 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6258 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6259 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6260 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6261 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6267 c----------------------------------------------------------------------------
6268 subroutine multibody(ecorr)
6269 C This subroutine calculates multi-body contributions to energy following
6270 C the idea of Skolnick et al. If side chains I and J make a contact and
6271 C at the same time side chains I+1 and J+1 make a contact, an extra
6272 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6273 implicit real*8 (a-h,o-z)
6274 include 'DIMENSIONS'
6275 include 'COMMON.IOUNITS'
6276 include 'COMMON.DERIV'
6277 include 'COMMON.INTERACT'
6278 include 'COMMON.CONTACTS'
6279 double precision gx(3),gx1(3)
6282 C Set lprn=.true. for debugging
6286 write (iout,'(a)') 'Contact function values:'
6288 write (iout,'(i2,20(1x,i2,f10.5))')
6289 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6304 num_conti=num_cont(i)
6305 num_conti1=num_cont(i1)
6310 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6311 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6312 cd & ' ishift=',ishift
6313 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6314 C The system gains extra energy.
6315 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6316 endif ! j1==j+-ishift
6325 c------------------------------------------------------------------------------
6326 double precision function esccorr(i,j,k,l,jj,kk)
6327 implicit real*8 (a-h,o-z)
6328 include 'DIMENSIONS'
6329 include 'COMMON.IOUNITS'
6330 include 'COMMON.DERIV'
6331 include 'COMMON.INTERACT'
6332 include 'COMMON.CONTACTS'
6333 double precision gx(3),gx1(3)
6338 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6339 C Calculate the multi-body contribution to energy.
6340 C Calculate multi-body contributions to the gradient.
6341 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6342 cd & k,l,(gacont(m,kk,k),m=1,3)
6344 gx(m) =ekl*gacont(m,jj,i)
6345 gx1(m)=eij*gacont(m,kk,k)
6346 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6347 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6348 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6349 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6353 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6358 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6364 c------------------------------------------------------------------------------
6365 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6366 C This subroutine calculates multi-body contributions to hydrogen-bonding
6367 implicit real*8 (a-h,o-z)
6368 include 'DIMENSIONS'
6369 include 'COMMON.IOUNITS'
6372 parameter (max_cont=maxconts)
6373 parameter (max_dim=26)
6374 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6375 double precision zapas(max_dim,maxconts,max_fg_procs),
6376 & zapas_recv(max_dim,maxconts,max_fg_procs)
6377 common /przechowalnia/ zapas
6378 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6379 & status_array(MPI_STATUS_SIZE,maxconts*2)
6381 include 'COMMON.SETUP'
6382 include 'COMMON.FFIELD'
6383 include 'COMMON.DERIV'
6384 include 'COMMON.INTERACT'
6385 include 'COMMON.CONTACTS'
6386 include 'COMMON.CONTROL'
6387 include 'COMMON.LOCAL'
6388 double precision gx(3),gx1(3),time00
6391 C Set lprn=.true. for debugging
6396 if (nfgtasks.le.1) goto 30
6398 write (iout,'(a)') 'Contact function values before RECEIVE:'
6400 write (iout,'(2i3,50(1x,i2,f5.2))')
6401 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6402 & j=1,num_cont_hb(i))
6406 do i=1,ntask_cont_from
6409 do i=1,ntask_cont_to
6412 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6414 C Make the list of contacts to send to send to other procesors
6415 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6417 do i=iturn3_start,iturn3_end
6418 c write (iout,*) "make contact list turn3",i," num_cont",
6420 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6422 do i=iturn4_start,iturn4_end
6423 c write (iout,*) "make contact list turn4",i," num_cont",
6425 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6429 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6431 do j=1,num_cont_hb(i)
6434 iproc=iint_sent_local(k,jjc,ii)
6435 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6436 if (iproc.gt.0) then
6437 ncont_sent(iproc)=ncont_sent(iproc)+1
6438 nn=ncont_sent(iproc)
6440 zapas(2,nn,iproc)=jjc
6441 zapas(3,nn,iproc)=facont_hb(j,i)
6442 zapas(4,nn,iproc)=ees0p(j,i)
6443 zapas(5,nn,iproc)=ees0m(j,i)
6444 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6445 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6446 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6447 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6448 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6449 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6450 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6451 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6452 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6453 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6454 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6455 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6456 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6457 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6458 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6459 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6460 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6461 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6462 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6463 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6464 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6471 & "Numbers of contacts to be sent to other processors",
6472 & (ncont_sent(i),i=1,ntask_cont_to)
6473 write (iout,*) "Contacts sent"
6474 do ii=1,ntask_cont_to
6476 iproc=itask_cont_to(ii)
6477 write (iout,*) nn," contacts to processor",iproc,
6478 & " of CONT_TO_COMM group"
6480 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6488 CorrelID1=nfgtasks+fg_rank+1
6490 C Receive the numbers of needed contacts from other processors
6491 do ii=1,ntask_cont_from
6492 iproc=itask_cont_from(ii)
6494 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6495 & FG_COMM,req(ireq),IERR)
6497 c write (iout,*) "IRECV ended"
6499 C Send the number of contacts needed by other processors
6500 do ii=1,ntask_cont_to
6501 iproc=itask_cont_to(ii)
6503 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6504 & FG_COMM,req(ireq),IERR)
6506 c write (iout,*) "ISEND ended"
6507 c write (iout,*) "number of requests (nn)",ireq
6510 & call MPI_Waitall(ireq,req,status_array,ierr)
6512 c & "Numbers of contacts to be received from other processors",
6513 c & (ncont_recv(i),i=1,ntask_cont_from)
6517 do ii=1,ntask_cont_from
6518 iproc=itask_cont_from(ii)
6520 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6521 c & " of CONT_TO_COMM group"
6525 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6526 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6527 c write (iout,*) "ireq,req",ireq,req(ireq)
6530 C Send the contacts to processors that need them
6531 do ii=1,ntask_cont_to
6532 iproc=itask_cont_to(ii)
6534 c write (iout,*) nn," contacts to processor",iproc,
6535 c & " of CONT_TO_COMM group"
6538 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6539 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6540 c write (iout,*) "ireq,req",ireq,req(ireq)
6542 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6546 c write (iout,*) "number of requests (contacts)",ireq
6547 c write (iout,*) "req",(req(i),i=1,4)
6550 & call MPI_Waitall(ireq,req,status_array,ierr)
6551 do iii=1,ntask_cont_from
6552 iproc=itask_cont_from(iii)
6555 write (iout,*) "Received",nn," contacts from processor",iproc,
6556 & " of CONT_FROM_COMM group"
6559 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6564 ii=zapas_recv(1,i,iii)
6565 c Flag the received contacts to prevent double-counting
6566 jj=-zapas_recv(2,i,iii)
6567 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6569 nnn=num_cont_hb(ii)+1
6572 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6573 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6574 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6575 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6576 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6577 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6578 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6579 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6580 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6581 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6582 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6583 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6584 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6585 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6586 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6587 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6588 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6589 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6590 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6591 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6592 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6593 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6594 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6595 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6600 write (iout,'(a)') 'Contact function values after receive:'
6602 write (iout,'(2i3,50(1x,i3,f5.2))')
6603 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6604 & j=1,num_cont_hb(i))
6611 write (iout,'(a)') 'Contact function values:'
6613 write (iout,'(2i3,50(1x,i3,f5.2))')
6614 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6615 & j=1,num_cont_hb(i))
6619 C Remove the loop below after debugging !!!
6626 C Calculate the local-electrostatic correlation terms
6627 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6629 num_conti=num_cont_hb(i)
6630 num_conti1=num_cont_hb(i+1)
6637 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6638 c & ' jj=',jj,' kk=',kk
6639 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6640 & .or. j.lt.0 .and. j1.gt.0) .and.
6641 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6642 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6643 C The system gains extra energy.
6644 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6645 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6646 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6648 else if (j1.eq.j) then
6649 C Contacts I-J and I-(J+1) occur simultaneously.
6650 C The system loses extra energy.
6651 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6656 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6657 c & ' jj=',jj,' kk=',kk
6659 C Contacts I-J and (I+1)-J occur simultaneously.
6660 C The system loses extra energy.
6661 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6668 c------------------------------------------------------------------------------
6669 subroutine add_hb_contact(ii,jj,itask)
6670 implicit real*8 (a-h,o-z)
6671 include "DIMENSIONS"
6672 include "COMMON.IOUNITS"
6675 parameter (max_cont=maxconts)
6676 parameter (max_dim=26)
6677 include "COMMON.CONTACTS"
6678 double precision zapas(max_dim,maxconts,max_fg_procs),
6679 & zapas_recv(max_dim,maxconts,max_fg_procs)
6680 common /przechowalnia/ zapas
6681 integer i,j,ii,jj,iproc,itask(4),nn
6682 c write (iout,*) "itask",itask
6685 if (iproc.gt.0) then
6686 do j=1,num_cont_hb(ii)
6688 c write (iout,*) "i",ii," j",jj," jjc",jjc
6690 ncont_sent(iproc)=ncont_sent(iproc)+1
6691 nn=ncont_sent(iproc)
6692 zapas(1,nn,iproc)=ii
6693 zapas(2,nn,iproc)=jjc
6694 zapas(3,nn,iproc)=facont_hb(j,ii)
6695 zapas(4,nn,iproc)=ees0p(j,ii)
6696 zapas(5,nn,iproc)=ees0m(j,ii)
6697 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6698 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6699 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6700 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6701 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6702 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6703 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6704 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6705 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6706 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6707 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6708 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6709 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6710 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6711 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6712 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6713 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6714 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6715 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6716 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6717 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6725 c------------------------------------------------------------------------------
6726 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6728 C This subroutine calculates multi-body contributions to hydrogen-bonding
6729 implicit real*8 (a-h,o-z)
6730 include 'DIMENSIONS'
6731 include 'COMMON.IOUNITS'
6734 parameter (max_cont=maxconts)
6735 parameter (max_dim=70)
6736 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6737 double precision zapas(max_dim,maxconts,max_fg_procs),
6738 & zapas_recv(max_dim,maxconts,max_fg_procs)
6739 common /przechowalnia/ zapas
6740 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6741 & status_array(MPI_STATUS_SIZE,maxconts*2)
6743 include 'COMMON.SETUP'
6744 include 'COMMON.FFIELD'
6745 include 'COMMON.DERIV'
6746 include 'COMMON.LOCAL'
6747 include 'COMMON.INTERACT'
6748 include 'COMMON.CONTACTS'
6749 include 'COMMON.CHAIN'
6750 include 'COMMON.CONTROL'
6751 double precision gx(3),gx1(3)
6752 integer num_cont_hb_old(maxres)
6754 double precision eello4,eello5,eelo6,eello_turn6
6755 external eello4,eello5,eello6,eello_turn6
6756 C Set lprn=.true. for debugging
6761 num_cont_hb_old(i)=num_cont_hb(i)
6765 if (nfgtasks.le.1) goto 30
6767 write (iout,'(a)') 'Contact function values before RECEIVE:'
6769 write (iout,'(2i3,50(1x,i2,f5.2))')
6770 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6771 & j=1,num_cont_hb(i))
6775 do i=1,ntask_cont_from
6778 do i=1,ntask_cont_to
6781 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6783 C Make the list of contacts to send to send to other procesors
6784 do i=iturn3_start,iturn3_end
6785 c write (iout,*) "make contact list turn3",i," num_cont",
6787 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6789 do i=iturn4_start,iturn4_end
6790 c write (iout,*) "make contact list turn4",i," num_cont",
6792 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6796 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6798 do j=1,num_cont_hb(i)
6801 iproc=iint_sent_local(k,jjc,ii)
6802 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6803 if (iproc.ne.0) then
6804 ncont_sent(iproc)=ncont_sent(iproc)+1
6805 nn=ncont_sent(iproc)
6807 zapas(2,nn,iproc)=jjc
6808 zapas(3,nn,iproc)=d_cont(j,i)
6812 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6817 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6825 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6836 & "Numbers of contacts to be sent to other processors",
6837 & (ncont_sent(i),i=1,ntask_cont_to)
6838 write (iout,*) "Contacts sent"
6839 do ii=1,ntask_cont_to
6841 iproc=itask_cont_to(ii)
6842 write (iout,*) nn," contacts to processor",iproc,
6843 & " of CONT_TO_COMM group"
6845 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6853 CorrelID1=nfgtasks+fg_rank+1
6855 C Receive the numbers of needed contacts from other processors
6856 do ii=1,ntask_cont_from
6857 iproc=itask_cont_from(ii)
6859 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6860 & FG_COMM,req(ireq),IERR)
6862 c write (iout,*) "IRECV ended"
6864 C Send the number of contacts needed by other processors
6865 do ii=1,ntask_cont_to
6866 iproc=itask_cont_to(ii)
6868 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6869 & FG_COMM,req(ireq),IERR)
6871 c write (iout,*) "ISEND ended"
6872 c write (iout,*) "number of requests (nn)",ireq
6875 & call MPI_Waitall(ireq,req,status_array,ierr)
6877 c & "Numbers of contacts to be received from other processors",
6878 c & (ncont_recv(i),i=1,ntask_cont_from)
6882 do ii=1,ntask_cont_from
6883 iproc=itask_cont_from(ii)
6885 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6886 c & " of CONT_TO_COMM group"
6890 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6891 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6892 c write (iout,*) "ireq,req",ireq,req(ireq)
6895 C Send the contacts to processors that need them
6896 do ii=1,ntask_cont_to
6897 iproc=itask_cont_to(ii)
6899 c write (iout,*) nn," contacts to processor",iproc,
6900 c & " of CONT_TO_COMM group"
6903 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6904 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6905 c write (iout,*) "ireq,req",ireq,req(ireq)
6907 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6911 c write (iout,*) "number of requests (contacts)",ireq
6912 c write (iout,*) "req",(req(i),i=1,4)
6915 & call MPI_Waitall(ireq,req,status_array,ierr)
6916 do iii=1,ntask_cont_from
6917 iproc=itask_cont_from(iii)
6920 write (iout,*) "Received",nn," contacts from processor",iproc,
6921 & " of CONT_FROM_COMM group"
6924 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6929 ii=zapas_recv(1,i,iii)
6930 c Flag the received contacts to prevent double-counting
6931 jj=-zapas_recv(2,i,iii)
6932 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6934 nnn=num_cont_hb(ii)+1
6937 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6941 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6946 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6954 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6963 write (iout,'(a)') 'Contact function values after receive:'
6965 write (iout,'(2i3,50(1x,i3,5f6.3))')
6966 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6967 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6974 write (iout,'(a)') 'Contact function values:'
6976 write (iout,'(2i3,50(1x,i2,5f6.3))')
6977 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6978 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6984 C Remove the loop below after debugging !!!
6991 C Calculate the dipole-dipole interaction energies
6992 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6993 do i=iatel_s,iatel_e+1
6994 num_conti=num_cont_hb(i)
7003 C Calculate the local-electrostatic correlation terms
7004 c write (iout,*) "gradcorr5 in eello5 before loop"
7006 c write (iout,'(i5,3f10.5)')
7007 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7009 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7010 c write (iout,*) "corr loop i",i
7012 num_conti=num_cont_hb(i)
7013 num_conti1=num_cont_hb(i+1)
7020 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7021 c & ' jj=',jj,' kk=',kk
7022 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7023 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7024 & .or. j.lt.0 .and. j1.gt.0) .and.
7025 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7026 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7027 C The system gains extra energy.
7029 sqd1=dsqrt(d_cont(jj,i))
7030 sqd2=dsqrt(d_cont(kk,i1))
7031 sred_geom = sqd1*sqd2
7032 IF (sred_geom.lt.cutoff_corr) THEN
7033 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7035 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7036 cd & ' jj=',jj,' kk=',kk
7037 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7038 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7040 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7041 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7044 cd write (iout,*) 'sred_geom=',sred_geom,
7045 cd & ' ekont=',ekont,' fprim=',fprimcont,
7046 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7047 cd write (iout,*) "g_contij",g_contij
7048 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7049 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7050 call calc_eello(i,jp,i+1,jp1,jj,kk)
7051 if (wcorr4.gt.0.0d0)
7052 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7053 if (energy_dec.and.wcorr4.gt.0.0d0)
7054 1 write (iout,'(a6,4i5,0pf7.3)')
7055 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7056 c write (iout,*) "gradcorr5 before eello5"
7058 c write (iout,'(i5,3f10.5)')
7059 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7061 if (wcorr5.gt.0.0d0)
7062 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7063 c write (iout,*) "gradcorr5 after eello5"
7065 c write (iout,'(i5,3f10.5)')
7066 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7068 if (energy_dec.and.wcorr5.gt.0.0d0)
7069 1 write (iout,'(a6,4i5,0pf7.3)')
7070 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7071 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7072 cd write(2,*)'ijkl',i,jp,i+1,jp1
7073 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7074 & .or. wturn6.eq.0.0d0))then
7075 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7076 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7077 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7078 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7079 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7080 cd & 'ecorr6=',ecorr6
7081 cd write (iout,'(4e15.5)') sred_geom,
7082 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7083 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7084 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7085 else if (wturn6.gt.0.0d0
7086 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7087 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7088 eturn6=eturn6+eello_turn6(i,jj,kk)
7089 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7090 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7091 cd write (2,*) 'multibody_eello:eturn6',eturn6
7100 num_cont_hb(i)=num_cont_hb_old(i)
7102 c write (iout,*) "gradcorr5 in eello5"
7104 c write (iout,'(i5,3f10.5)')
7105 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7109 c------------------------------------------------------------------------------
7110 subroutine add_hb_contact_eello(ii,jj,itask)
7111 implicit real*8 (a-h,o-z)
7112 include "DIMENSIONS"
7113 include "COMMON.IOUNITS"
7116 parameter (max_cont=maxconts)
7117 parameter (max_dim=70)
7118 include "COMMON.CONTACTS"
7119 double precision zapas(max_dim,maxconts,max_fg_procs),
7120 & zapas_recv(max_dim,maxconts,max_fg_procs)
7121 common /przechowalnia/ zapas
7122 integer i,j,ii,jj,iproc,itask(4),nn
7123 c write (iout,*) "itask",itask
7126 if (iproc.gt.0) then
7127 do j=1,num_cont_hb(ii)
7129 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7131 ncont_sent(iproc)=ncont_sent(iproc)+1
7132 nn=ncont_sent(iproc)
7133 zapas(1,nn,iproc)=ii
7134 zapas(2,nn,iproc)=jjc
7135 zapas(3,nn,iproc)=d_cont(j,ii)
7139 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7144 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7152 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7164 c------------------------------------------------------------------------------
7165 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7166 implicit real*8 (a-h,o-z)
7167 include 'DIMENSIONS'
7168 include 'COMMON.IOUNITS'
7169 include 'COMMON.DERIV'
7170 include 'COMMON.INTERACT'
7171 include 'COMMON.CONTACTS'
7172 double precision gx(3),gx1(3)
7182 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7183 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7184 C Following 4 lines for diagnostics.
7189 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7190 c & 'Contacts ',i,j,
7191 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7192 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7194 C Calculate the multi-body contribution to energy.
7195 c ecorr=ecorr+ekont*ees
7196 C Calculate multi-body contributions to the gradient.
7197 coeffpees0pij=coeffp*ees0pij
7198 coeffmees0mij=coeffm*ees0mij
7199 coeffpees0pkl=coeffp*ees0pkl
7200 coeffmees0mkl=coeffm*ees0mkl
7202 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7203 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7204 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7205 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7206 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7207 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7208 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7209 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7210 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7211 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7212 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7213 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7214 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7215 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7216 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7217 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7218 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7219 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7220 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7221 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7222 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7223 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7224 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7225 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7226 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7231 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7232 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7233 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7234 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7239 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7240 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7241 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7242 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7245 c write (iout,*) "ehbcorr",ekont*ees
7250 C---------------------------------------------------------------------------
7251 subroutine dipole(i,j,jj)
7252 implicit real*8 (a-h,o-z)
7253 include 'DIMENSIONS'
7254 include 'COMMON.IOUNITS'
7255 include 'COMMON.CHAIN'
7256 include 'COMMON.FFIELD'
7257 include 'COMMON.DERIV'
7258 include 'COMMON.INTERACT'
7259 include 'COMMON.CONTACTS'
7260 include 'COMMON.TORSION'
7261 include 'COMMON.VAR'
7262 include 'COMMON.GEO'
7263 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7265 iti1 = itortyp(itype(i+1))
7266 if (j.lt.nres-1) then
7267 itj1 = itortyp(itype(j+1))
7272 dipi(iii,1)=Ub2(iii,i)
7273 dipderi(iii)=Ub2der(iii,i)
7274 dipi(iii,2)=b1(iii,iti1)
7275 dipj(iii,1)=Ub2(iii,j)
7276 dipderj(iii)=Ub2der(iii,j)
7277 dipj(iii,2)=b1(iii,itj1)
7281 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7284 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7291 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7295 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7300 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7301 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7303 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7305 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7307 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7312 C---------------------------------------------------------------------------
7313 subroutine calc_eello(i,j,k,l,jj,kk)
7315 C This subroutine computes matrices and vectors needed to calculate
7316 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7318 implicit real*8 (a-h,o-z)
7319 include 'DIMENSIONS'
7320 include 'COMMON.IOUNITS'
7321 include 'COMMON.CHAIN'
7322 include 'COMMON.DERIV'
7323 include 'COMMON.INTERACT'
7324 include 'COMMON.CONTACTS'
7325 include 'COMMON.TORSION'
7326 include 'COMMON.VAR'
7327 include 'COMMON.GEO'
7328 include 'COMMON.FFIELD'
7329 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7330 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7333 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7334 cd & ' jj=',jj,' kk=',kk
7335 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7336 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7337 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7340 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7341 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7344 call transpose2(aa1(1,1),aa1t(1,1))
7345 call transpose2(aa2(1,1),aa2t(1,1))
7348 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7349 & aa1tder(1,1,lll,kkk))
7350 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7351 & aa2tder(1,1,lll,kkk))
7355 C parallel orientation of the two CA-CA-CA frames.
7357 iti=itortyp(itype(i))
7361 itk1=itortyp(itype(k+1))
7362 itj=itortyp(itype(j))
7363 if (l.lt.nres-1) then
7364 itl1=itortyp(itype(l+1))
7368 C A1 kernel(j+1) A2T
7370 cd write (iout,'(3f10.5,5x,3f10.5)')
7371 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7373 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7374 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7375 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7376 C Following matrices are needed only for 6-th order cumulants
7377 IF (wcorr6.gt.0.0d0) THEN
7378 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7379 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7380 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7381 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7382 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7383 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7384 & ADtEAderx(1,1,1,1,1,1))
7386 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7387 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7388 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7389 & ADtEA1derx(1,1,1,1,1,1))
7391 C End 6-th order cumulants
7394 cd write (2,*) 'In calc_eello6'
7396 cd write (2,*) 'iii=',iii
7398 cd write (2,*) 'kkk=',kkk
7400 cd write (2,'(3(2f10.5),5x)')
7401 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7406 call transpose2(EUgder(1,1,k),auxmat(1,1))
7407 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7408 call transpose2(EUg(1,1,k),auxmat(1,1))
7409 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7410 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7414 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7415 & EAEAderx(1,1,lll,kkk,iii,1))
7419 C A1T kernel(i+1) A2
7420 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7421 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7422 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7423 C Following matrices are needed only for 6-th order cumulants
7424 IF (wcorr6.gt.0.0d0) THEN
7425 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7426 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7427 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7428 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7429 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7430 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7431 & ADtEAderx(1,1,1,1,1,2))
7432 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7433 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7434 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7435 & ADtEA1derx(1,1,1,1,1,2))
7437 C End 6-th order cumulants
7438 call transpose2(EUgder(1,1,l),auxmat(1,1))
7439 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7440 call transpose2(EUg(1,1,l),auxmat(1,1))
7441 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7442 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7446 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7447 & EAEAderx(1,1,lll,kkk,iii,2))
7452 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7453 C They are needed only when the fifth- or the sixth-order cumulants are
7455 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7456 call transpose2(AEA(1,1,1),auxmat(1,1))
7457 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7458 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7459 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7460 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7461 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7462 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7463 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7464 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7465 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7466 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7467 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7468 call transpose2(AEA(1,1,2),auxmat(1,1))
7469 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7470 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7471 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7472 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7473 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7474 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7475 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7476 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7477 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7478 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7479 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7480 C Calculate the Cartesian derivatives of the vectors.
7484 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7485 call matvec2(auxmat(1,1),b1(1,iti),
7486 & AEAb1derx(1,lll,kkk,iii,1,1))
7487 call matvec2(auxmat(1,1),Ub2(1,i),
7488 & AEAb2derx(1,lll,kkk,iii,1,1))
7489 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7490 & AEAb1derx(1,lll,kkk,iii,2,1))
7491 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7492 & AEAb2derx(1,lll,kkk,iii,2,1))
7493 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7494 call matvec2(auxmat(1,1),b1(1,itj),
7495 & AEAb1derx(1,lll,kkk,iii,1,2))
7496 call matvec2(auxmat(1,1),Ub2(1,j),
7497 & AEAb2derx(1,lll,kkk,iii,1,2))
7498 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7499 & AEAb1derx(1,lll,kkk,iii,2,2))
7500 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7501 & AEAb2derx(1,lll,kkk,iii,2,2))
7508 C Antiparallel orientation of the two CA-CA-CA frames.
7510 iti=itortyp(itype(i))
7514 itk1=itortyp(itype(k+1))
7515 itl=itortyp(itype(l))
7516 itj=itortyp(itype(j))
7517 if (j.lt.nres-1) then
7518 itj1=itortyp(itype(j+1))
7522 C A2 kernel(j-1)T A1T
7523 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7524 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7525 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7526 C Following matrices are needed only for 6-th order cumulants
7527 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7528 & j.eq.i+4 .and. l.eq.i+3)) THEN
7529 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7530 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7531 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7532 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7533 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7534 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7535 & ADtEAderx(1,1,1,1,1,1))
7536 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7537 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7538 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7539 & ADtEA1derx(1,1,1,1,1,1))
7541 C End 6-th order cumulants
7542 call transpose2(EUgder(1,1,k),auxmat(1,1))
7543 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7544 call transpose2(EUg(1,1,k),auxmat(1,1))
7545 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7546 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7550 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7551 & EAEAderx(1,1,lll,kkk,iii,1))
7555 C A2T kernel(i+1)T A1
7556 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7557 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7558 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7559 C Following matrices are needed only for 6-th order cumulants
7560 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7561 & j.eq.i+4 .and. l.eq.i+3)) THEN
7562 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7563 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7564 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7565 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7566 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7567 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7568 & ADtEAderx(1,1,1,1,1,2))
7569 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7570 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7571 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7572 & ADtEA1derx(1,1,1,1,1,2))
7574 C End 6-th order cumulants
7575 call transpose2(EUgder(1,1,j),auxmat(1,1))
7576 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7577 call transpose2(EUg(1,1,j),auxmat(1,1))
7578 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7579 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7583 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7584 & EAEAderx(1,1,lll,kkk,iii,2))
7589 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7590 C They are needed only when the fifth- or the sixth-order cumulants are
7592 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7593 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7594 call transpose2(AEA(1,1,1),auxmat(1,1))
7595 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7596 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7597 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7598 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7599 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7600 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7601 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7602 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7603 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7604 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7605 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7606 call transpose2(AEA(1,1,2),auxmat(1,1))
7607 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7608 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7609 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7610 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7611 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7612 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7613 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7614 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7615 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7616 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7617 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7618 C Calculate the Cartesian derivatives of the vectors.
7622 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7623 call matvec2(auxmat(1,1),b1(1,iti),
7624 & AEAb1derx(1,lll,kkk,iii,1,1))
7625 call matvec2(auxmat(1,1),Ub2(1,i),
7626 & AEAb2derx(1,lll,kkk,iii,1,1))
7627 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7628 & AEAb1derx(1,lll,kkk,iii,2,1))
7629 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7630 & AEAb2derx(1,lll,kkk,iii,2,1))
7631 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7632 call matvec2(auxmat(1,1),b1(1,itl),
7633 & AEAb1derx(1,lll,kkk,iii,1,2))
7634 call matvec2(auxmat(1,1),Ub2(1,l),
7635 & AEAb2derx(1,lll,kkk,iii,1,2))
7636 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7637 & AEAb1derx(1,lll,kkk,iii,2,2))
7638 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7639 & AEAb2derx(1,lll,kkk,iii,2,2))
7648 C---------------------------------------------------------------------------
7649 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7650 & KK,KKderg,AKA,AKAderg,AKAderx)
7654 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7655 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7656 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7661 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7663 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7666 cd if (lprn) write (2,*) 'In kernel'
7668 cd if (lprn) write (2,*) 'kkk=',kkk
7670 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7671 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7673 cd write (2,*) 'lll=',lll
7674 cd write (2,*) 'iii=1'
7676 cd write (2,'(3(2f10.5),5x)')
7677 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7680 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7681 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7683 cd write (2,*) 'lll=',lll
7684 cd write (2,*) 'iii=2'
7686 cd write (2,'(3(2f10.5),5x)')
7687 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7694 C---------------------------------------------------------------------------
7695 double precision function eello4(i,j,k,l,jj,kk)
7696 implicit real*8 (a-h,o-z)
7697 include 'DIMENSIONS'
7698 include 'COMMON.IOUNITS'
7699 include 'COMMON.CHAIN'
7700 include 'COMMON.DERIV'
7701 include 'COMMON.INTERACT'
7702 include 'COMMON.CONTACTS'
7703 include 'COMMON.TORSION'
7704 include 'COMMON.VAR'
7705 include 'COMMON.GEO'
7706 double precision pizda(2,2),ggg1(3),ggg2(3)
7707 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7711 cd print *,'eello4:',i,j,k,l,jj,kk
7712 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7713 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7714 cold eij=facont_hb(jj,i)
7715 cold ekl=facont_hb(kk,k)
7717 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7718 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7719 gcorr_loc(k-1)=gcorr_loc(k-1)
7720 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7722 gcorr_loc(l-1)=gcorr_loc(l-1)
7723 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7725 gcorr_loc(j-1)=gcorr_loc(j-1)
7726 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7731 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7732 & -EAEAderx(2,2,lll,kkk,iii,1)
7733 cd derx(lll,kkk,iii)=0.0d0
7737 cd gcorr_loc(l-1)=0.0d0
7738 cd gcorr_loc(j-1)=0.0d0
7739 cd gcorr_loc(k-1)=0.0d0
7741 cd write (iout,*)'Contacts have occurred for peptide groups',
7742 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7743 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7744 if (j.lt.nres-1) then
7751 if (l.lt.nres-1) then
7759 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7760 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7761 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7762 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7763 cgrad ghalf=0.5d0*ggg1(ll)
7764 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7765 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7766 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7767 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7768 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7769 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7770 cgrad ghalf=0.5d0*ggg2(ll)
7771 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7772 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7773 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7774 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7775 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7776 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7780 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7785 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7790 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7795 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7799 cd write (2,*) iii,gcorr_loc(iii)
7802 cd write (2,*) 'ekont',ekont
7803 cd write (iout,*) 'eello4',ekont*eel4
7806 C---------------------------------------------------------------------------
7807 double precision function eello5(i,j,k,l,jj,kk)
7808 implicit real*8 (a-h,o-z)
7809 include 'DIMENSIONS'
7810 include 'COMMON.IOUNITS'
7811 include 'COMMON.CHAIN'
7812 include 'COMMON.DERIV'
7813 include 'COMMON.INTERACT'
7814 include 'COMMON.CONTACTS'
7815 include 'COMMON.TORSION'
7816 include 'COMMON.VAR'
7817 include 'COMMON.GEO'
7818 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7819 double precision ggg1(3),ggg2(3)
7820 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7825 C /l\ / \ \ / \ / \ / C
7826 C / \ / \ \ / \ / \ / C
7827 C j| o |l1 | o | o| o | | o |o C
7828 C \ |/k\| |/ \| / |/ \| |/ \| C
7829 C \i/ \ / \ / / \ / \ C
7831 C (I) (II) (III) (IV) C
7833 C eello5_1 eello5_2 eello5_3 eello5_4 C
7835 C Antiparallel chains C
7838 C /j\ / \ \ / \ / \ / C
7839 C / \ / \ \ / \ / \ / C
7840 C j1| o |l | o | o| o | | o |o C
7841 C \ |/k\| |/ \| / |/ \| |/ \| C
7842 C \i/ \ / \ / / \ / \ C
7844 C (I) (II) (III) (IV) C
7846 C eello5_1 eello5_2 eello5_3 eello5_4 C
7848 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7850 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7851 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7856 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7858 itk=itortyp(itype(k))
7859 itl=itortyp(itype(l))
7860 itj=itortyp(itype(j))
7865 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7866 cd & eel5_3_num,eel5_4_num)
7870 derx(lll,kkk,iii)=0.0d0
7874 cd eij=facont_hb(jj,i)
7875 cd ekl=facont_hb(kk,k)
7877 cd write (iout,*)'Contacts have occurred for peptide groups',
7878 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7880 C Contribution from the graph I.
7881 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7882 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7883 call transpose2(EUg(1,1,k),auxmat(1,1))
7884 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7885 vv(1)=pizda(1,1)-pizda(2,2)
7886 vv(2)=pizda(1,2)+pizda(2,1)
7887 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7888 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7889 C Explicit gradient in virtual-dihedral angles.
7890 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7891 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7892 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7893 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7894 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7895 vv(1)=pizda(1,1)-pizda(2,2)
7896 vv(2)=pizda(1,2)+pizda(2,1)
7897 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7898 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7899 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7900 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7901 vv(1)=pizda(1,1)-pizda(2,2)
7902 vv(2)=pizda(1,2)+pizda(2,1)
7904 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7905 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7906 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7908 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7909 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7910 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7912 C Cartesian gradient
7916 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7918 vv(1)=pizda(1,1)-pizda(2,2)
7919 vv(2)=pizda(1,2)+pizda(2,1)
7920 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7921 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7922 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7928 C Contribution from graph II
7929 call transpose2(EE(1,1,itk),auxmat(1,1))
7930 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7931 vv(1)=pizda(1,1)+pizda(2,2)
7932 vv(2)=pizda(2,1)-pizda(1,2)
7933 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7934 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7935 C Explicit gradient in virtual-dihedral angles.
7936 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7937 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7938 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7939 vv(1)=pizda(1,1)+pizda(2,2)
7940 vv(2)=pizda(2,1)-pizda(1,2)
7942 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7943 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7944 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7946 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7947 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7948 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7950 C Cartesian gradient
7954 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7956 vv(1)=pizda(1,1)+pizda(2,2)
7957 vv(2)=pizda(2,1)-pizda(1,2)
7958 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7959 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7960 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7968 C Parallel orientation
7969 C Contribution from graph III
7970 call transpose2(EUg(1,1,l),auxmat(1,1))
7971 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7972 vv(1)=pizda(1,1)-pizda(2,2)
7973 vv(2)=pizda(1,2)+pizda(2,1)
7974 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7975 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7976 C Explicit gradient in virtual-dihedral angles.
7977 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7978 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7979 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7980 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7981 vv(1)=pizda(1,1)-pizda(2,2)
7982 vv(2)=pizda(1,2)+pizda(2,1)
7983 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7984 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7985 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7986 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7987 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7988 vv(1)=pizda(1,1)-pizda(2,2)
7989 vv(2)=pizda(1,2)+pizda(2,1)
7990 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7991 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7992 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7993 C Cartesian gradient
7997 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7999 vv(1)=pizda(1,1)-pizda(2,2)
8000 vv(2)=pizda(1,2)+pizda(2,1)
8001 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8002 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8003 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8008 C Contribution from graph IV
8010 call transpose2(EE(1,1,itl),auxmat(1,1))
8011 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8012 vv(1)=pizda(1,1)+pizda(2,2)
8013 vv(2)=pizda(2,1)-pizda(1,2)
8014 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
8015 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8016 C Explicit gradient in virtual-dihedral angles.
8017 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8018 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8019 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8020 vv(1)=pizda(1,1)+pizda(2,2)
8021 vv(2)=pizda(2,1)-pizda(1,2)
8022 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8023 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
8024 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8025 C Cartesian gradient
8029 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8031 vv(1)=pizda(1,1)+pizda(2,2)
8032 vv(2)=pizda(2,1)-pizda(1,2)
8033 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8034 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
8035 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8040 C Antiparallel orientation
8041 C Contribution from graph III
8043 call transpose2(EUg(1,1,j),auxmat(1,1))
8044 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8045 vv(1)=pizda(1,1)-pizda(2,2)
8046 vv(2)=pizda(1,2)+pizda(2,1)
8047 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8048 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8049 C Explicit gradient in virtual-dihedral angles.
8050 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8051 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8052 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8053 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8054 vv(1)=pizda(1,1)-pizda(2,2)
8055 vv(2)=pizda(1,2)+pizda(2,1)
8056 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8057 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8058 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8059 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8060 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8061 vv(1)=pizda(1,1)-pizda(2,2)
8062 vv(2)=pizda(1,2)+pizda(2,1)
8063 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8064 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8065 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8066 C Cartesian gradient
8070 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8072 vv(1)=pizda(1,1)-pizda(2,2)
8073 vv(2)=pizda(1,2)+pizda(2,1)
8074 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8075 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8076 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8081 C Contribution from graph IV
8083 call transpose2(EE(1,1,itj),auxmat(1,1))
8084 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8085 vv(1)=pizda(1,1)+pizda(2,2)
8086 vv(2)=pizda(2,1)-pizda(1,2)
8087 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
8088 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8089 C Explicit gradient in virtual-dihedral angles.
8090 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8091 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8092 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8093 vv(1)=pizda(1,1)+pizda(2,2)
8094 vv(2)=pizda(2,1)-pizda(1,2)
8095 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8096 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
8097 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8098 C Cartesian gradient
8102 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8104 vv(1)=pizda(1,1)+pizda(2,2)
8105 vv(2)=pizda(2,1)-pizda(1,2)
8106 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8107 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
8108 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8114 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8115 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8116 cd write (2,*) 'ijkl',i,j,k,l
8117 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8118 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8120 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8121 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8122 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8123 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8124 if (j.lt.nres-1) then
8131 if (l.lt.nres-1) then
8141 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8142 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8143 C summed up outside the subrouine as for the other subroutines
8144 C handling long-range interactions. The old code is commented out
8145 C with "cgrad" to keep track of changes.
8147 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8148 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8149 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8150 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8151 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8152 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8153 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8154 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8155 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8156 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8158 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8159 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8160 cgrad ghalf=0.5d0*ggg1(ll)
8162 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8163 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8164 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8165 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8166 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8167 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8168 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8169 cgrad ghalf=0.5d0*ggg2(ll)
8171 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8172 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8173 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8174 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8175 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8176 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8181 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8182 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8187 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8188 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8194 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8199 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8203 cd write (2,*) iii,g_corr5_loc(iii)
8206 cd write (2,*) 'ekont',ekont
8207 cd write (iout,*) 'eello5',ekont*eel5
8210 c--------------------------------------------------------------------------
8211 double precision function eello6(i,j,k,l,jj,kk)
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 include 'COMMON.FFIELD'
8223 double precision ggg1(3),ggg2(3)
8224 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8229 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8237 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8238 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8242 derx(lll,kkk,iii)=0.0d0
8246 cd eij=facont_hb(jj,i)
8247 cd ekl=facont_hb(kk,k)
8253 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8254 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8255 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8256 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8257 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8258 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8260 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8261 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8262 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8263 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8264 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8265 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8269 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8271 C If turn contributions are considered, they will be handled separately.
8272 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8273 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8274 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8275 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8276 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8277 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8278 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8280 if (j.lt.nres-1) then
8287 if (l.lt.nres-1) then
8295 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8296 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8297 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8298 cgrad ghalf=0.5d0*ggg1(ll)
8300 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8301 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8302 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8303 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8304 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8305 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8306 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8307 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8308 cgrad ghalf=0.5d0*ggg2(ll)
8309 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8311 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8312 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8313 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8314 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8315 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8316 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8321 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8322 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8327 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8328 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8334 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8339 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8343 cd write (2,*) iii,g_corr6_loc(iii)
8346 cd write (2,*) 'ekont',ekont
8347 cd write (iout,*) 'eello6',ekont*eel6
8350 c--------------------------------------------------------------------------
8351 double precision function eello6_graph1(i,j,k,l,imat,swap)
8352 implicit real*8 (a-h,o-z)
8353 include 'DIMENSIONS'
8354 include 'COMMON.IOUNITS'
8355 include 'COMMON.CHAIN'
8356 include 'COMMON.DERIV'
8357 include 'COMMON.INTERACT'
8358 include 'COMMON.CONTACTS'
8359 include 'COMMON.TORSION'
8360 include 'COMMON.VAR'
8361 include 'COMMON.GEO'
8362 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8366 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8368 C Parallel Antiparallel C
8374 C \ j|/k\| / \ |/k\|l / C
8379 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8380 itk=itortyp(itype(k))
8381 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8382 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8383 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8384 call transpose2(EUgC(1,1,k),auxmat(1,1))
8385 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8386 vv1(1)=pizda1(1,1)-pizda1(2,2)
8387 vv1(2)=pizda1(1,2)+pizda1(2,1)
8388 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8389 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8390 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8391 s5=scalar2(vv(1),Dtobr2(1,i))
8392 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8393 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8394 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8395 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8396 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8397 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8398 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8399 & +scalar2(vv(1),Dtobr2der(1,i)))
8400 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8401 vv1(1)=pizda1(1,1)-pizda1(2,2)
8402 vv1(2)=pizda1(1,2)+pizda1(2,1)
8403 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8404 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8406 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8407 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8408 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8409 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8410 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8412 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8413 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8414 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8415 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8416 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8418 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8419 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8420 vv1(1)=pizda1(1,1)-pizda1(2,2)
8421 vv1(2)=pizda1(1,2)+pizda1(2,1)
8422 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8423 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8424 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8425 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8434 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8435 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8436 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8437 call transpose2(EUgC(1,1,k),auxmat(1,1))
8438 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8440 vv1(1)=pizda1(1,1)-pizda1(2,2)
8441 vv1(2)=pizda1(1,2)+pizda1(2,1)
8442 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8443 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8444 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8445 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8446 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8447 s5=scalar2(vv(1),Dtobr2(1,i))
8448 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8454 c----------------------------------------------------------------------------
8455 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8456 implicit real*8 (a-h,o-z)
8457 include 'DIMENSIONS'
8458 include 'COMMON.IOUNITS'
8459 include 'COMMON.CHAIN'
8460 include 'COMMON.DERIV'
8461 include 'COMMON.INTERACT'
8462 include 'COMMON.CONTACTS'
8463 include 'COMMON.TORSION'
8464 include 'COMMON.VAR'
8465 include 'COMMON.GEO'
8467 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8468 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8471 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8473 C Parallel Antiparallel C
8479 C \ j|/k\| \ |/k\|l C
8484 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8485 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8486 C AL 7/4/01 s1 would occur in the sixth-order moment,
8487 C but not in a cluster cumulant
8489 s1=dip(1,jj,i)*dip(1,kk,k)
8491 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8492 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8493 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8494 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8495 call transpose2(EUg(1,1,k),auxmat(1,1))
8496 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8497 vv(1)=pizda(1,1)-pizda(2,2)
8498 vv(2)=pizda(1,2)+pizda(2,1)
8499 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8500 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8502 eello6_graph2=-(s1+s2+s3+s4)
8504 eello6_graph2=-(s2+s3+s4)
8507 C Derivatives in gamma(i-1)
8510 s1=dipderg(1,jj,i)*dip(1,kk,k)
8512 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8513 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8514 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8515 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8517 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8519 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8521 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8523 C Derivatives in gamma(k-1)
8525 s1=dip(1,jj,i)*dipderg(1,kk,k)
8527 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8528 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8529 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8530 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8531 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8532 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8533 vv(1)=pizda(1,1)-pizda(2,2)
8534 vv(2)=pizda(1,2)+pizda(2,1)
8535 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8537 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8539 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8541 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8542 C Derivatives in gamma(j-1) or gamma(l-1)
8545 s1=dipderg(3,jj,i)*dip(1,kk,k)
8547 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8548 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8549 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8550 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8551 vv(1)=pizda(1,1)-pizda(2,2)
8552 vv(2)=pizda(1,2)+pizda(2,1)
8553 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8556 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8558 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8561 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8562 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8564 C Derivatives in gamma(l-1) or gamma(j-1)
8567 s1=dip(1,jj,i)*dipderg(3,kk,k)
8569 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8570 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8571 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8572 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8573 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8574 vv(1)=pizda(1,1)-pizda(2,2)
8575 vv(2)=pizda(1,2)+pizda(2,1)
8576 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8579 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8581 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8584 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8585 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8587 C Cartesian derivatives.
8589 write (2,*) 'In eello6_graph2'
8591 write (2,*) 'iii=',iii
8593 write (2,*) 'kkk=',kkk
8595 write (2,'(3(2f10.5),5x)')
8596 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8606 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8608 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8611 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8613 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8614 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8616 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8617 call transpose2(EUg(1,1,k),auxmat(1,1))
8618 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8620 vv(1)=pizda(1,1)-pizda(2,2)
8621 vv(2)=pizda(1,2)+pizda(2,1)
8622 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8623 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8625 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8627 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8630 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8632 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8639 c----------------------------------------------------------------------------
8640 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8641 implicit real*8 (a-h,o-z)
8642 include 'DIMENSIONS'
8643 include 'COMMON.IOUNITS'
8644 include 'COMMON.CHAIN'
8645 include 'COMMON.DERIV'
8646 include 'COMMON.INTERACT'
8647 include 'COMMON.CONTACTS'
8648 include 'COMMON.TORSION'
8649 include 'COMMON.VAR'
8650 include 'COMMON.GEO'
8651 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8653 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8655 C Parallel Antiparallel C
8661 C j|/k\| / |/k\|l / C
8666 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8668 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8669 C energy moment and not to the cluster cumulant.
8670 iti=itortyp(itype(i))
8671 if (j.lt.nres-1) then
8672 itj1=itortyp(itype(j+1))
8676 itk=itortyp(itype(k))
8677 itk1=itortyp(itype(k+1))
8678 if (l.lt.nres-1) then
8679 itl1=itortyp(itype(l+1))
8684 s1=dip(4,jj,i)*dip(4,kk,k)
8686 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8687 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8688 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8689 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8690 call transpose2(EE(1,1,itk),auxmat(1,1))
8691 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8692 vv(1)=pizda(1,1)+pizda(2,2)
8693 vv(2)=pizda(2,1)-pizda(1,2)
8694 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8695 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8696 cd & "sum",-(s2+s3+s4)
8698 eello6_graph3=-(s1+s2+s3+s4)
8700 eello6_graph3=-(s2+s3+s4)
8703 C Derivatives in gamma(k-1)
8704 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8705 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8706 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8707 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8708 C Derivatives in gamma(l-1)
8709 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8710 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8711 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8712 vv(1)=pizda(1,1)+pizda(2,2)
8713 vv(2)=pizda(2,1)-pizda(1,2)
8714 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8715 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8716 C Cartesian derivatives.
8722 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8724 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8727 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8729 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8730 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8732 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8733 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8735 vv(1)=pizda(1,1)+pizda(2,2)
8736 vv(2)=pizda(2,1)-pizda(1,2)
8737 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8739 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8741 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8744 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8746 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8748 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8754 c----------------------------------------------------------------------------
8755 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8756 implicit real*8 (a-h,o-z)
8757 include 'DIMENSIONS'
8758 include 'COMMON.IOUNITS'
8759 include 'COMMON.CHAIN'
8760 include 'COMMON.DERIV'
8761 include 'COMMON.INTERACT'
8762 include 'COMMON.CONTACTS'
8763 include 'COMMON.TORSION'
8764 include 'COMMON.VAR'
8765 include 'COMMON.GEO'
8766 include 'COMMON.FFIELD'
8767 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8768 & auxvec1(2),auxmat1(2,2)
8770 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8772 C Parallel Antiparallel C
8778 C \ j|/k\| \ |/k\|l C
8783 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8785 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8786 C energy moment and not to the cluster cumulant.
8787 cd write (2,*) 'eello_graph4: wturn6',wturn6
8788 iti=itortyp(itype(i))
8789 itj=itortyp(itype(j))
8790 if (j.lt.nres-1) then
8791 itj1=itortyp(itype(j+1))
8795 itk=itortyp(itype(k))
8796 if (k.lt.nres-1) then
8797 itk1=itortyp(itype(k+1))
8801 itl=itortyp(itype(l))
8802 if (l.lt.nres-1) then
8803 itl1=itortyp(itype(l+1))
8807 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8808 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8809 cd & ' itl',itl,' itl1',itl1
8812 s1=dip(3,jj,i)*dip(3,kk,k)
8814 s1=dip(2,jj,j)*dip(2,kk,l)
8817 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8818 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8820 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8821 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8823 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8824 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8826 call transpose2(EUg(1,1,k),auxmat(1,1))
8827 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8828 vv(1)=pizda(1,1)-pizda(2,2)
8829 vv(2)=pizda(2,1)+pizda(1,2)
8830 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8831 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8833 eello6_graph4=-(s1+s2+s3+s4)
8835 eello6_graph4=-(s2+s3+s4)
8837 C Derivatives in gamma(i-1)
8841 s1=dipderg(2,jj,i)*dip(3,kk,k)
8843 s1=dipderg(4,jj,j)*dip(2,kk,l)
8846 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8848 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8849 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8851 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8852 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8854 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8855 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8856 cd write (2,*) 'turn6 derivatives'
8858 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8860 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8864 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8866 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8870 C Derivatives in gamma(k-1)
8873 s1=dip(3,jj,i)*dipderg(2,kk,k)
8875 s1=dip(2,jj,j)*dipderg(4,kk,l)
8878 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8879 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8881 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8882 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8884 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8885 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8887 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8888 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8889 vv(1)=pizda(1,1)-pizda(2,2)
8890 vv(2)=pizda(2,1)+pizda(1,2)
8891 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8892 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8894 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8896 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8900 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8902 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8905 C Derivatives in gamma(j-1) or gamma(l-1)
8906 if (l.eq.j+1 .and. l.gt.1) then
8907 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8908 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8909 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8910 vv(1)=pizda(1,1)-pizda(2,2)
8911 vv(2)=pizda(2,1)+pizda(1,2)
8912 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8913 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8914 else if (j.gt.1) then
8915 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8916 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8917 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8918 vv(1)=pizda(1,1)-pizda(2,2)
8919 vv(2)=pizda(2,1)+pizda(1,2)
8920 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8921 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8922 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8924 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8927 C Cartesian derivatives.
8934 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8936 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8940 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8942 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8946 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8948 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8950 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8951 & b1(1,itj1),auxvec(1))
8952 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8954 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8955 & b1(1,itl1),auxvec(1))
8956 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8958 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8960 vv(1)=pizda(1,1)-pizda(2,2)
8961 vv(2)=pizda(2,1)+pizda(1,2)
8962 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8964 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8966 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8969 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8972 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8975 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8977 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8979 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8983 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8985 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8988 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8990 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8998 c----------------------------------------------------------------------------
8999 double precision function eello_turn6(i,jj,kk)
9000 implicit real*8 (a-h,o-z)
9001 include 'DIMENSIONS'
9002 include 'COMMON.IOUNITS'
9003 include 'COMMON.CHAIN'
9004 include 'COMMON.DERIV'
9005 include 'COMMON.INTERACT'
9006 include 'COMMON.CONTACTS'
9007 include 'COMMON.TORSION'
9008 include 'COMMON.VAR'
9009 include 'COMMON.GEO'
9010 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9011 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9013 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9014 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9015 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9016 C the respective energy moment and not to the cluster cumulant.
9025 iti=itortyp(itype(i))
9026 itk=itortyp(itype(k))
9027 itk1=itortyp(itype(k+1))
9028 itl=itortyp(itype(l))
9029 itj=itortyp(itype(j))
9030 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9031 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9032 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9037 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9039 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9043 derx_turn(lll,kkk,iii)=0.0d0
9050 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9052 cd write (2,*) 'eello6_5',eello6_5
9054 call transpose2(AEA(1,1,1),auxmat(1,1))
9055 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9056 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9057 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9059 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9060 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9061 s2 = scalar2(b1(1,itk),vtemp1(1))
9063 call transpose2(AEA(1,1,2),atemp(1,1))
9064 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9065 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9066 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9068 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9069 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9070 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9072 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9073 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9074 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9075 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9076 ss13 = scalar2(b1(1,itk),vtemp4(1))
9077 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9079 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9085 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9086 C Derivatives in gamma(i+2)
9090 call transpose2(AEA(1,1,1),auxmatd(1,1))
9091 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9092 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9093 call transpose2(AEAderg(1,1,2),atempd(1,1))
9094 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9095 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9097 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9098 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9099 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9105 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9106 C Derivatives in gamma(i+3)
9108 call transpose2(AEA(1,1,1),auxmatd(1,1))
9109 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9110 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9111 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9113 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9114 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9115 s2d = scalar2(b1(1,itk),vtemp1d(1))
9117 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9118 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9120 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9122 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9123 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9124 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9132 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9133 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9135 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9136 & -0.5d0*ekont*(s2d+s12d)
9138 C Derivatives in gamma(i+4)
9139 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9140 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9141 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9143 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9144 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9145 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9153 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9155 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9157 C Derivatives in gamma(i+5)
9159 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9160 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9161 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9163 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9164 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9165 s2d = scalar2(b1(1,itk),vtemp1d(1))
9167 call transpose2(AEA(1,1,2),atempd(1,1))
9168 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9169 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9171 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9172 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9174 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9175 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9176 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9184 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9185 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9187 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9188 & -0.5d0*ekont*(s2d+s12d)
9190 C Cartesian derivatives
9195 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9196 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9197 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9199 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9200 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9202 s2d = scalar2(b1(1,itk),vtemp1d(1))
9204 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9205 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9206 s8d = -(atempd(1,1)+atempd(2,2))*
9207 & scalar2(cc(1,1,itl),vtemp2(1))
9209 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9211 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9212 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9219 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9222 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9226 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9227 & - 0.5d0*(s8d+s12d)
9229 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9238 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9240 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9241 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9242 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9243 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9244 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9246 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9247 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9248 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9252 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9253 cd & 16*eel_turn6_num
9255 if (j.lt.nres-1) then
9262 if (l.lt.nres-1) then
9270 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9271 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9272 cgrad ghalf=0.5d0*ggg1(ll)
9274 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9275 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9276 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9277 & +ekont*derx_turn(ll,2,1)
9278 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9279 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9280 & +ekont*derx_turn(ll,4,1)
9281 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9282 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9283 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9284 cgrad ghalf=0.5d0*ggg2(ll)
9286 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9287 & +ekont*derx_turn(ll,2,2)
9288 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9289 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9290 & +ekont*derx_turn(ll,4,2)
9291 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9292 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9293 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9298 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9303 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9309 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9314 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9318 cd write (2,*) iii,g_corr6_loc(iii)
9320 eello_turn6=ekont*eel_turn6
9321 cd write (2,*) 'ekont',ekont
9322 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9326 C-----------------------------------------------------------------------------
9327 double precision function scalar(u,v)
9328 !DIR$ INLINEALWAYS scalar
9330 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9333 double precision u(3),v(3)
9334 cd double precision sc
9342 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9345 crc-------------------------------------------------
9346 SUBROUTINE MATVEC2(A1,V1,V2)
9347 !DIR$ INLINEALWAYS MATVEC2
9349 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9351 implicit real*8 (a-h,o-z)
9352 include 'DIMENSIONS'
9353 DIMENSION A1(2,2),V1(2),V2(2)
9357 c 3 VI=VI+A1(I,K)*V1(K)
9361 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9362 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9367 C---------------------------------------
9368 SUBROUTINE MATMAT2(A1,A2,A3)
9370 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9372 implicit real*8 (a-h,o-z)
9373 include 'DIMENSIONS'
9374 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9375 c DIMENSION AI3(2,2)
9379 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9385 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9386 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9387 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9388 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9396 c-------------------------------------------------------------------------
9397 double precision function scalar2(u,v)
9398 !DIR$ INLINEALWAYS scalar2
9400 double precision u(2),v(2)
9403 scalar2=u(1)*v(1)+u(2)*v(2)
9407 C-----------------------------------------------------------------------------
9409 subroutine transpose2(a,at)
9410 !DIR$ INLINEALWAYS transpose2
9412 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9415 double precision a(2,2),at(2,2)
9422 c--------------------------------------------------------------------------
9423 subroutine transpose(n,a,at)
9426 double precision a(n,n),at(n,n)
9434 C---------------------------------------------------------------------------
9435 subroutine prodmat3(a1,a2,kk,transp,prod)
9436 !DIR$ INLINEALWAYS prodmat3
9438 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9442 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9444 crc double precision auxmat(2,2),prod_(2,2)
9447 crc call transpose2(kk(1,1),auxmat(1,1))
9448 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9449 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9451 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9452 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9453 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9454 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9455 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9456 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9457 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9458 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9461 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9462 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9464 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9465 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9466 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9467 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9468 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9469 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9470 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9471 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9474 c call transpose2(a2(1,1),a2t(1,1))
9477 crc print *,((prod_(i,j),i=1,2),j=1,2)
9478 crc print *,((prod(i,j),i=1,2),j=1,2)