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 write (iout,*) "Soft-spheer ELEC potential"
156 c 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
1469 C xi=xi+xshift*boxxsize
1470 C yi=yi+yshift*boxysize
1471 C zi=zi+zshift*boxzsize
1473 dxi=dc_norm(1,nres+i)
1474 dyi=dc_norm(2,nres+i)
1475 dzi=dc_norm(3,nres+i)
1476 c dsci_inv=dsc_inv(itypi)
1477 dsci_inv=vbld_inv(i+nres)
1478 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1479 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1481 C Calculate SC interaction energy.
1483 do iint=1,nint_gr(i)
1484 do j=istart(i,iint),iend(i,iint)
1486 itypj=iabs(itype(j))
1487 if (itypj.eq.ntyp1) cycle
1488 c dscj_inv=dsc_inv(itypj)
1489 dscj_inv=vbld_inv(j+nres)
1490 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1491 c & 1.0d0/vbld(j+nres)
1492 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1493 sig0ij=sigma(itypi,itypj)
1494 chi1=chi(itypi,itypj)
1495 chi2=chi(itypj,itypi)
1502 alf12=0.5D0*(alf1+alf2)
1503 C For diagnostics only!!!
1516 C Return atom J into box the original box
1518 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1519 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1520 C Condition for being inside the proper box
1521 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1522 c & (xj.lt.((-0.5d0)*boxxsize))) then
1526 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1527 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1528 C Condition for being inside the proper box
1529 c if ((yj.gt.((0.5d0)*boxysize)).or.
1530 c & (yj.lt.((-0.5d0)*boxysize))) then
1534 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1535 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1536 C Condition for being inside the proper box
1537 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1538 c & (zj.lt.((-0.5d0)*boxzsize))) then
1542 if (xj.lt.0) xj=xj+boxxsize
1544 if (yj.lt.0) yj=yj+boxysize
1546 if (zj.lt.0) zj=zj+boxzsize
1547 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1555 xj=xj_safe+xshift*boxxsize
1556 yj=yj_safe+yshift*boxysize
1557 zj=zj_safe+zshift*boxzsize
1558 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1559 if(dist_temp.lt.dist_init) then
1569 if (subchap.eq.1) then
1578 dxj=dc_norm(1,nres+j)
1579 dyj=dc_norm(2,nres+j)
1580 dzj=dc_norm(3,nres+j)
1584 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1585 c write (iout,*) "j",j," dc_norm",
1586 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1587 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1589 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1590 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1592 c write (iout,'(a7,4f8.3)')
1593 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1594 if (sss.gt.0.0d0) then
1595 C Calculate angle-dependent terms of energy and contributions to their
1599 sig=sig0ij*dsqrt(sigsq)
1600 rij_shift=1.0D0/rij-sig+sig0ij
1601 c for diagnostics; uncomment
1602 c rij_shift=1.2*sig0ij
1603 C I hate to put IF's in the loops, but here don't have another choice!!!!
1604 if (rij_shift.le.0.0D0) then
1606 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1607 cd & restyp(itypi),i,restyp(itypj),j,
1608 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1612 c---------------------------------------------------------------
1613 rij_shift=1.0D0/rij_shift
1614 fac=rij_shift**expon
1615 e1=fac*fac*aa(itypi,itypj)
1616 e2=fac*bb(itypi,itypj)
1617 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1618 eps2der=evdwij*eps3rt
1619 eps3der=evdwij*eps2rt
1620 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1621 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1622 evdwij=evdwij*eps2rt*eps3rt
1623 evdw=evdw+evdwij*sss
1625 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1626 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1627 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1628 & restyp(itypi),i,restyp(itypj),j,
1629 & epsi,sigm,chi1,chi2,chip1,chip2,
1630 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1631 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1635 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1638 C Calculate gradient components.
1639 e1=e1*eps1*eps2rt**2*eps3rt**2
1640 fac=-expon*(e1+evdwij)*rij_shift
1643 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1644 c & evdwij,fac,sigma(itypi,itypj),expon
1645 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1647 C Calculate the radial part of the gradient
1651 C Calculate angular part of the gradient.
1660 c write (iout,*) "Number of loop steps in EGB:",ind
1661 cccc energy_dec=.false.
1664 C-----------------------------------------------------------------------------
1665 subroutine egbv(evdw)
1667 C This subroutine calculates the interaction energy of nonbonded side chains
1668 C assuming the Gay-Berne-Vorobjev potential of interaction.
1670 implicit real*8 (a-h,o-z)
1671 include 'DIMENSIONS'
1672 include 'COMMON.GEO'
1673 include 'COMMON.VAR'
1674 include 'COMMON.LOCAL'
1675 include 'COMMON.CHAIN'
1676 include 'COMMON.DERIV'
1677 include 'COMMON.NAMES'
1678 include 'COMMON.INTERACT'
1679 include 'COMMON.IOUNITS'
1680 include 'COMMON.CALC'
1681 common /srutu/ icall
1684 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1687 c if (icall.eq.0) lprn=.true.
1689 do i=iatsc_s,iatsc_e
1690 itypi=iabs(itype(i))
1691 if (itypi.eq.ntyp1) cycle
1692 itypi1=iabs(itype(i+1))
1696 dxi=dc_norm(1,nres+i)
1697 dyi=dc_norm(2,nres+i)
1698 dzi=dc_norm(3,nres+i)
1699 c dsci_inv=dsc_inv(itypi)
1700 dsci_inv=vbld_inv(i+nres)
1702 C Calculate SC interaction energy.
1704 do iint=1,nint_gr(i)
1705 do j=istart(i,iint),iend(i,iint)
1707 itypj=iabs(itype(j))
1708 if (itypj.eq.ntyp1) cycle
1709 c dscj_inv=dsc_inv(itypj)
1710 dscj_inv=vbld_inv(j+nres)
1711 sig0ij=sigma(itypi,itypj)
1712 r0ij=r0(itypi,itypj)
1713 chi1=chi(itypi,itypj)
1714 chi2=chi(itypj,itypi)
1721 alf12=0.5D0*(alf1+alf2)
1722 C For diagnostics only!!!
1735 dxj=dc_norm(1,nres+j)
1736 dyj=dc_norm(2,nres+j)
1737 dzj=dc_norm(3,nres+j)
1738 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1740 C Calculate angle-dependent terms of energy and contributions to their
1744 sig=sig0ij*dsqrt(sigsq)
1745 rij_shift=1.0D0/rij-sig+r0ij
1746 C I hate to put IF's in the loops, but here don't have another choice!!!!
1747 if (rij_shift.le.0.0D0) then
1752 c---------------------------------------------------------------
1753 rij_shift=1.0D0/rij_shift
1754 fac=rij_shift**expon
1755 e1=fac*fac*aa(itypi,itypj)
1756 e2=fac*bb(itypi,itypj)
1757 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1758 eps2der=evdwij*eps3rt
1759 eps3der=evdwij*eps2rt
1760 fac_augm=rrij**expon
1761 e_augm=augm(itypi,itypj)*fac_augm
1762 evdwij=evdwij*eps2rt*eps3rt
1763 evdw=evdw+evdwij+e_augm
1765 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1766 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1767 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1768 & restyp(itypi),i,restyp(itypj),j,
1769 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1770 & chi1,chi2,chip1,chip2,
1771 & eps1,eps2rt**2,eps3rt**2,
1772 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1775 C Calculate gradient components.
1776 e1=e1*eps1*eps2rt**2*eps3rt**2
1777 fac=-expon*(e1+evdwij)*rij_shift
1779 fac=rij*fac-2*expon*rrij*e_augm
1780 C Calculate the radial part of the gradient
1784 C Calculate angular part of the gradient.
1790 C-----------------------------------------------------------------------------
1791 subroutine sc_angular
1792 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1793 C om12. Called by ebp, egb, and egbv.
1795 include 'COMMON.CALC'
1796 include 'COMMON.IOUNITS'
1800 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1801 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1802 om12=dxi*dxj+dyi*dyj+dzi*dzj
1804 C Calculate eps1(om12) and its derivative in om12
1805 faceps1=1.0D0-om12*chiom12
1806 faceps1_inv=1.0D0/faceps1
1807 eps1=dsqrt(faceps1_inv)
1808 C Following variable is eps1*deps1/dom12
1809 eps1_om12=faceps1_inv*chiom12
1814 c write (iout,*) "om12",om12," eps1",eps1
1815 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1820 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1821 sigsq=1.0D0-facsig*faceps1_inv
1822 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1823 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1824 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1830 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1831 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1833 C Calculate eps2 and its derivatives in om1, om2, and om12.
1836 chipom12=chip12*om12
1837 facp=1.0D0-om12*chipom12
1839 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1840 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1841 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1842 C Following variable is the square root of eps2
1843 eps2rt=1.0D0-facp1*facp_inv
1844 C Following three variables are the derivatives of the square root of eps
1845 C in om1, om2, and om12.
1846 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1847 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1848 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1849 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1850 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1851 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1852 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1853 c & " eps2rt_om12",eps2rt_om12
1854 C Calculate whole angle-dependent part of epsilon and contributions
1855 C to its derivatives
1858 C----------------------------------------------------------------------------
1860 implicit real*8 (a-h,o-z)
1861 include 'DIMENSIONS'
1862 include 'COMMON.CHAIN'
1863 include 'COMMON.DERIV'
1864 include 'COMMON.CALC'
1865 include 'COMMON.IOUNITS'
1866 double precision dcosom1(3),dcosom2(3)
1867 cc print *,'sss=',sss
1868 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1869 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1870 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1871 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1875 c eom12=evdwij*eps1_om12
1877 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1878 c & " sigder",sigder
1879 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1880 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1882 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1883 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1886 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
1888 c write (iout,*) "gg",(gg(k),k=1,3)
1890 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1891 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1892 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
1893 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1894 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1895 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
1896 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1897 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1898 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1899 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1902 C Calculate the components of the gradient in DC and X
1906 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1910 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1911 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1915 C-----------------------------------------------------------------------
1916 subroutine e_softsphere(evdw)
1918 C This subroutine calculates the interaction energy of nonbonded side chains
1919 C assuming the LJ potential of interaction.
1921 implicit real*8 (a-h,o-z)
1922 include 'DIMENSIONS'
1923 parameter (accur=1.0d-10)
1924 include 'COMMON.GEO'
1925 include 'COMMON.VAR'
1926 include 'COMMON.LOCAL'
1927 include 'COMMON.CHAIN'
1928 include 'COMMON.DERIV'
1929 include 'COMMON.INTERACT'
1930 include 'COMMON.TORSION'
1931 include 'COMMON.SBRIDGE'
1932 include 'COMMON.NAMES'
1933 include 'COMMON.IOUNITS'
1934 include 'COMMON.CONTACTS'
1936 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1938 do i=iatsc_s,iatsc_e
1939 itypi=iabs(itype(i))
1940 if (itypi.eq.ntyp1) cycle
1941 itypi1=iabs(itype(i+1))
1946 C Calculate SC interaction energy.
1948 do iint=1,nint_gr(i)
1949 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1950 cd & 'iend=',iend(i,iint)
1951 do j=istart(i,iint),iend(i,iint)
1952 itypj=iabs(itype(j))
1953 if (itypj.eq.ntyp1) cycle
1957 rij=xj*xj+yj*yj+zj*zj
1958 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1959 r0ij=r0(itypi,itypj)
1961 c print *,i,j,r0ij,dsqrt(rij)
1962 if (rij.lt.r0ijsq) then
1963 evdwij=0.25d0*(rij-r0ijsq)**2
1971 C Calculate the components of the gradient in DC and X
1977 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1978 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1979 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1980 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1984 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1992 C--------------------------------------------------------------------------
1993 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1996 C Soft-sphere potential of p-p interaction
1998 implicit real*8 (a-h,o-z)
1999 include 'DIMENSIONS'
2000 include 'COMMON.CONTROL'
2001 include 'COMMON.IOUNITS'
2002 include 'COMMON.GEO'
2003 include 'COMMON.VAR'
2004 include 'COMMON.LOCAL'
2005 include 'COMMON.CHAIN'
2006 include 'COMMON.DERIV'
2007 include 'COMMON.INTERACT'
2008 include 'COMMON.CONTACTS'
2009 include 'COMMON.TORSION'
2010 include 'COMMON.VECTORS'
2011 include 'COMMON.FFIELD'
2013 C write(iout,*) 'In EELEC_soft_sphere'
2020 do i=iatel_s,iatel_e
2021 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2025 xmedi=c(1,i)+0.5d0*dxi
2026 ymedi=c(2,i)+0.5d0*dyi
2027 zmedi=c(3,i)+0.5d0*dzi
2028 xmedi=mod(xmedi,boxxsize)
2029 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2030 ymedi=mod(ymedi,boxysize)
2031 if (ymedi.lt.0) ymedi=ymedi+boxysize
2032 zmedi=mod(zmedi,boxzsize)
2033 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2035 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2036 do j=ielstart(i),ielend(i)
2037 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2041 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2042 r0ij=rpp(iteli,itelj)
2051 if (xj.lt.0) xj=xj+boxxsize
2053 if (yj.lt.0) yj=yj+boxysize
2055 if (zj.lt.0) zj=zj+boxzsize
2056 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2064 xj=xj_safe+xshift*boxxsize
2065 yj=yj_safe+yshift*boxysize
2066 zj=zj_safe+zshift*boxzsize
2067 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2068 if(dist_temp.lt.dist_init) then
2078 if (isubchap.eq.1) then
2087 rij=xj*xj+yj*yj+zj*zj
2088 sss=sscale(sqrt(rij))
2089 sssgrad=sscagrad(sqrt(rij))
2090 if (rij.lt.r0ijsq) then
2091 evdw1ij=0.25d0*(rij-r0ijsq)**2
2097 evdw1=evdw1+evdw1ij*sss
2099 C Calculate contributions to the Cartesian gradient.
2101 ggg(1)=fac*xj*sssgrad
2102 ggg(2)=fac*yj*sssgrad
2103 ggg(3)=fac*zj*sssgrad
2105 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2106 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2109 * Loop over residues i+1 thru j-1.
2113 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2118 cgrad do i=nnt,nct-1
2120 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2122 cgrad do j=i+1,nct-1
2124 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2130 c------------------------------------------------------------------------------
2131 subroutine vec_and_deriv
2132 implicit real*8 (a-h,o-z)
2133 include 'DIMENSIONS'
2137 include 'COMMON.IOUNITS'
2138 include 'COMMON.GEO'
2139 include 'COMMON.VAR'
2140 include 'COMMON.LOCAL'
2141 include 'COMMON.CHAIN'
2142 include 'COMMON.VECTORS'
2143 include 'COMMON.SETUP'
2144 include 'COMMON.TIME1'
2145 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2146 C Compute the local reference systems. For reference system (i), the
2147 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2148 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2150 do i=ivec_start,ivec_end
2154 if (i.eq.nres-1) then
2155 C Case of the last full residue
2156 C Compute the Z-axis
2157 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2158 costh=dcos(pi-theta(nres))
2159 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2163 C Compute the derivatives of uz
2165 uzder(2,1,1)=-dc_norm(3,i-1)
2166 uzder(3,1,1)= dc_norm(2,i-1)
2167 uzder(1,2,1)= dc_norm(3,i-1)
2169 uzder(3,2,1)=-dc_norm(1,i-1)
2170 uzder(1,3,1)=-dc_norm(2,i-1)
2171 uzder(2,3,1)= dc_norm(1,i-1)
2174 uzder(2,1,2)= dc_norm(3,i)
2175 uzder(3,1,2)=-dc_norm(2,i)
2176 uzder(1,2,2)=-dc_norm(3,i)
2178 uzder(3,2,2)= dc_norm(1,i)
2179 uzder(1,3,2)= dc_norm(2,i)
2180 uzder(2,3,2)=-dc_norm(1,i)
2182 C Compute the Y-axis
2185 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2187 C Compute the derivatives of uy
2190 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2191 & -dc_norm(k,i)*dc_norm(j,i-1)
2192 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2194 uyder(j,j,1)=uyder(j,j,1)-costh
2195 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2200 uygrad(l,k,j,i)=uyder(l,k,j)
2201 uzgrad(l,k,j,i)=uzder(l,k,j)
2205 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2206 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2207 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2208 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2211 C Compute the Z-axis
2212 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2213 costh=dcos(pi-theta(i+2))
2214 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2218 C Compute the derivatives of uz
2220 uzder(2,1,1)=-dc_norm(3,i+1)
2221 uzder(3,1,1)= dc_norm(2,i+1)
2222 uzder(1,2,1)= dc_norm(3,i+1)
2224 uzder(3,2,1)=-dc_norm(1,i+1)
2225 uzder(1,3,1)=-dc_norm(2,i+1)
2226 uzder(2,3,1)= dc_norm(1,i+1)
2229 uzder(2,1,2)= dc_norm(3,i)
2230 uzder(3,1,2)=-dc_norm(2,i)
2231 uzder(1,2,2)=-dc_norm(3,i)
2233 uzder(3,2,2)= dc_norm(1,i)
2234 uzder(1,3,2)= dc_norm(2,i)
2235 uzder(2,3,2)=-dc_norm(1,i)
2237 C Compute the Y-axis
2240 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2242 C Compute the derivatives of uy
2245 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2246 & -dc_norm(k,i)*dc_norm(j,i+1)
2247 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2249 uyder(j,j,1)=uyder(j,j,1)-costh
2250 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2255 uygrad(l,k,j,i)=uyder(l,k,j)
2256 uzgrad(l,k,j,i)=uzder(l,k,j)
2260 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2261 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2262 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2263 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2267 vbld_inv_temp(1)=vbld_inv(i+1)
2268 if (i.lt.nres-1) then
2269 vbld_inv_temp(2)=vbld_inv(i+2)
2271 vbld_inv_temp(2)=vbld_inv(i)
2276 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2277 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2282 #if defined(PARVEC) && defined(MPI)
2283 if (nfgtasks1.gt.1) then
2285 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2286 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2287 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2288 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2289 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2291 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2292 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2294 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2295 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2296 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2297 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2298 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2299 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2300 time_gather=time_gather+MPI_Wtime()-time00
2302 c if (fg_rank.eq.0) then
2303 c write (iout,*) "Arrays UY and UZ"
2305 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2312 C-----------------------------------------------------------------------------
2313 subroutine check_vecgrad
2314 implicit real*8 (a-h,o-z)
2315 include 'DIMENSIONS'
2316 include 'COMMON.IOUNITS'
2317 include 'COMMON.GEO'
2318 include 'COMMON.VAR'
2319 include 'COMMON.LOCAL'
2320 include 'COMMON.CHAIN'
2321 include 'COMMON.VECTORS'
2322 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2323 dimension uyt(3,maxres),uzt(3,maxres)
2324 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2325 double precision delta /1.0d-7/
2328 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2329 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2330 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2331 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2332 cd & (dc_norm(if90,i),if90=1,3)
2333 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2334 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2335 cd write(iout,'(a)')
2341 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2342 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2355 cd write (iout,*) 'i=',i
2357 erij(k)=dc_norm(k,i)
2361 dc_norm(k,i)=erij(k)
2363 dc_norm(j,i)=dc_norm(j,i)+delta
2364 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2366 c dc_norm(k,i)=dc_norm(k,i)/fac
2368 c write (iout,*) (dc_norm(k,i),k=1,3)
2369 c write (iout,*) (erij(k),k=1,3)
2372 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2373 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2374 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2375 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2377 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2378 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2379 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2382 dc_norm(k,i)=erij(k)
2385 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2386 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2387 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2388 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2389 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2390 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2391 cd write (iout,'(a)')
2396 C--------------------------------------------------------------------------
2397 subroutine set_matrices
2398 implicit real*8 (a-h,o-z)
2399 include 'DIMENSIONS'
2402 include "COMMON.SETUP"
2404 integer status(MPI_STATUS_SIZE)
2406 include 'COMMON.IOUNITS'
2407 include 'COMMON.GEO'
2408 include 'COMMON.VAR'
2409 include 'COMMON.LOCAL'
2410 include 'COMMON.CHAIN'
2411 include 'COMMON.DERIV'
2412 include 'COMMON.INTERACT'
2413 include 'COMMON.CONTACTS'
2414 include 'COMMON.TORSION'
2415 include 'COMMON.VECTORS'
2416 include 'COMMON.FFIELD'
2417 double precision auxvec(2),auxmat(2,2)
2419 C Compute the virtual-bond-torsional-angle dependent quantities needed
2420 C to calculate the el-loc multibody terms of various order.
2423 do i=ivec_start+2,ivec_end+2
2427 if (i .lt. nres+1) then
2464 if (i .gt. 3 .and. i .lt. nres+1) then
2465 obrot_der(1,i-2)=-sin1
2466 obrot_der(2,i-2)= cos1
2467 Ugder(1,1,i-2)= sin1
2468 Ugder(1,2,i-2)=-cos1
2469 Ugder(2,1,i-2)=-cos1
2470 Ugder(2,2,i-2)=-sin1
2473 obrot2_der(1,i-2)=-dwasin2
2474 obrot2_der(2,i-2)= dwacos2
2475 Ug2der(1,1,i-2)= dwasin2
2476 Ug2der(1,2,i-2)=-dwacos2
2477 Ug2der(2,1,i-2)=-dwacos2
2478 Ug2der(2,2,i-2)=-dwasin2
2480 obrot_der(1,i-2)=0.0d0
2481 obrot_der(2,i-2)=0.0d0
2482 Ugder(1,1,i-2)=0.0d0
2483 Ugder(1,2,i-2)=0.0d0
2484 Ugder(2,1,i-2)=0.0d0
2485 Ugder(2,2,i-2)=0.0d0
2486 obrot2_der(1,i-2)=0.0d0
2487 obrot2_der(2,i-2)=0.0d0
2488 Ug2der(1,1,i-2)=0.0d0
2489 Ug2der(1,2,i-2)=0.0d0
2490 Ug2der(2,1,i-2)=0.0d0
2491 Ug2der(2,2,i-2)=0.0d0
2493 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2494 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2495 iti = itortyp(itype(i-2))
2499 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2500 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2501 iti1 = itortyp(itype(i-1))
2505 cd write (iout,*) '*******i',i,' iti1',iti
2506 cd write (iout,*) 'b1',b1(:,iti)
2507 cd write (iout,*) 'b2',b2(:,iti)
2508 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2509 c if (i .gt. iatel_s+2) then
2510 if (i .gt. nnt+2) then
2511 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2512 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2513 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2515 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2516 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2517 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2518 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2519 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2530 DtUg2(l,k,i-2)=0.0d0
2534 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2535 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2537 muder(k,i-2)=Ub2der(k,i-2)
2539 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2540 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2541 if (itype(i-1).le.ntyp) then
2542 iti1 = itortyp(itype(i-1))
2550 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2552 cd write (iout,*) 'mu ',mu(:,i-2)
2553 cd write (iout,*) 'mu1',mu1(:,i-2)
2554 cd write (iout,*) 'mu2',mu2(:,i-2)
2555 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2557 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2558 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2559 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2560 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2561 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2562 C Vectors and matrices dependent on a single virtual-bond dihedral.
2563 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2564 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2565 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2566 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2567 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2568 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2569 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2570 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2571 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2574 C Matrices dependent on two consecutive virtual-bond dihedrals.
2575 C The order of matrices is from left to right.
2576 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2578 c do i=max0(ivec_start,2),ivec_end
2580 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2581 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2582 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2583 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2584 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2585 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2586 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2587 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2590 #if defined(MPI) && defined(PARMAT)
2592 c if (fg_rank.eq.0) then
2593 write (iout,*) "Arrays UG and UGDER before GATHER"
2595 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2596 & ((ug(l,k,i),l=1,2),k=1,2),
2597 & ((ugder(l,k,i),l=1,2),k=1,2)
2599 write (iout,*) "Arrays UG2 and UG2DER"
2601 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2602 & ((ug2(l,k,i),l=1,2),k=1,2),
2603 & ((ug2der(l,k,i),l=1,2),k=1,2)
2605 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2607 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2608 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2609 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2611 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2613 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2614 & costab(i),sintab(i),costab2(i),sintab2(i)
2616 write (iout,*) "Array MUDER"
2618 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2622 if (nfgtasks.gt.1) then
2624 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2625 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2626 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2628 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2629 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2631 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2632 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2634 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2635 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2637 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2638 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2640 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2641 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2643 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2644 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2646 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2647 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2648 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2649 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2650 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2651 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2652 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2653 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2654 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2655 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2656 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2657 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2658 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2660 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2661 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2663 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2664 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2666 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2667 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2669 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2670 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2672 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2673 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2675 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2676 & ivec_count(fg_rank1),
2677 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2679 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2680 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2682 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2683 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2685 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2686 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2688 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2689 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2691 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2692 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2694 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2695 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2697 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2698 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2700 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2701 & ivec_count(fg_rank1),
2702 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2704 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2705 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2707 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2708 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2710 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2711 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2713 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2714 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2716 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2717 & ivec_count(fg_rank1),
2718 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2720 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2721 & ivec_count(fg_rank1),
2722 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2724 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2725 & ivec_count(fg_rank1),
2726 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2727 & MPI_MAT2,FG_COMM1,IERR)
2728 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2729 & ivec_count(fg_rank1),
2730 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2731 & MPI_MAT2,FG_COMM1,IERR)
2734 c Passes matrix info through the ring
2737 if (irecv.lt.0) irecv=nfgtasks1-1
2740 if (inext.ge.nfgtasks1) inext=0
2742 c write (iout,*) "isend",isend," irecv",irecv
2744 lensend=lentyp(isend)
2745 lenrecv=lentyp(irecv)
2746 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2747 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2748 c & MPI_ROTAT1(lensend),inext,2200+isend,
2749 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2750 c & iprev,2200+irecv,FG_COMM,status,IERR)
2751 c write (iout,*) "Gather ROTAT1"
2753 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2754 c & MPI_ROTAT2(lensend),inext,3300+isend,
2755 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2756 c & iprev,3300+irecv,FG_COMM,status,IERR)
2757 c write (iout,*) "Gather ROTAT2"
2759 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2760 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2761 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2762 & iprev,4400+irecv,FG_COMM,status,IERR)
2763 c write (iout,*) "Gather ROTAT_OLD"
2765 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2766 & MPI_PRECOMP11(lensend),inext,5500+isend,
2767 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2768 & iprev,5500+irecv,FG_COMM,status,IERR)
2769 c write (iout,*) "Gather PRECOMP11"
2771 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2772 & MPI_PRECOMP12(lensend),inext,6600+isend,
2773 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2774 & iprev,6600+irecv,FG_COMM,status,IERR)
2775 c write (iout,*) "Gather PRECOMP12"
2777 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2779 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2780 & MPI_ROTAT2(lensend),inext,7700+isend,
2781 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2782 & iprev,7700+irecv,FG_COMM,status,IERR)
2783 c write (iout,*) "Gather PRECOMP21"
2785 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2786 & MPI_PRECOMP22(lensend),inext,8800+isend,
2787 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2788 & iprev,8800+irecv,FG_COMM,status,IERR)
2789 c write (iout,*) "Gather PRECOMP22"
2791 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2792 & MPI_PRECOMP23(lensend),inext,9900+isend,
2793 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2794 & MPI_PRECOMP23(lenrecv),
2795 & iprev,9900+irecv,FG_COMM,status,IERR)
2796 c write (iout,*) "Gather PRECOMP23"
2801 if (irecv.lt.0) irecv=nfgtasks1-1
2804 time_gather=time_gather+MPI_Wtime()-time00
2807 c if (fg_rank.eq.0) then
2808 write (iout,*) "Arrays UG and UGDER"
2810 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2811 & ((ug(l,k,i),l=1,2),k=1,2),
2812 & ((ugder(l,k,i),l=1,2),k=1,2)
2814 write (iout,*) "Arrays UG2 and UG2DER"
2816 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2817 & ((ug2(l,k,i),l=1,2),k=1,2),
2818 & ((ug2der(l,k,i),l=1,2),k=1,2)
2820 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2822 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2823 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2824 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2826 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2828 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2829 & costab(i),sintab(i),costab2(i),sintab2(i)
2831 write (iout,*) "Array MUDER"
2833 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2839 cd iti = itortyp(itype(i))
2842 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2843 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2848 C--------------------------------------------------------------------------
2849 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2851 C This subroutine calculates the average interaction energy and its gradient
2852 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2853 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2854 C The potential depends both on the distance of peptide-group centers and on
2855 C the orientation of the CA-CA virtual bonds.
2857 implicit real*8 (a-h,o-z)
2861 include 'DIMENSIONS'
2862 include 'COMMON.CONTROL'
2863 include 'COMMON.SETUP'
2864 include 'COMMON.IOUNITS'
2865 include 'COMMON.GEO'
2866 include 'COMMON.VAR'
2867 include 'COMMON.LOCAL'
2868 include 'COMMON.CHAIN'
2869 include 'COMMON.DERIV'
2870 include 'COMMON.INTERACT'
2871 include 'COMMON.CONTACTS'
2872 include 'COMMON.TORSION'
2873 include 'COMMON.VECTORS'
2874 include 'COMMON.FFIELD'
2875 include 'COMMON.TIME1'
2876 include 'COMMON.SPLITELE'
2877 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2878 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2879 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2880 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2881 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2882 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2884 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2886 double precision scal_el /1.0d0/
2888 double precision scal_el /0.5d0/
2891 C 13-go grudnia roku pamietnego...
2892 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2893 & 0.0d0,1.0d0,0.0d0,
2894 & 0.0d0,0.0d0,1.0d0/
2895 cd write(iout,*) 'In EELEC'
2897 cd write(iout,*) 'Type',i
2898 cd write(iout,*) 'B1',B1(:,i)
2899 cd write(iout,*) 'B2',B2(:,i)
2900 cd write(iout,*) 'CC',CC(:,:,i)
2901 cd write(iout,*) 'DD',DD(:,:,i)
2902 cd write(iout,*) 'EE',EE(:,:,i)
2904 cd call check_vecgrad
2906 if (icheckgrad.eq.1) then
2908 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2910 dc_norm(k,i)=dc(k,i)*fac
2912 c write (iout,*) 'i',i,' fac',fac
2915 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2916 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2917 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2918 c call vec_and_deriv
2924 time_mat=time_mat+MPI_Wtime()-time01
2928 cd write (iout,*) 'i=',i
2930 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2933 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2934 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2947 cd print '(a)','Enter EELEC'
2948 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2950 gel_loc_loc(i)=0.0d0
2955 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2957 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2959 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
2960 do i=iturn3_start,iturn3_end
2961 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2962 & .or. itype(i+2).eq.ntyp1
2963 & .or. itype(i+3).eq.ntyp1
2964 & .or. itype(i-1).eq.ntyp1
2965 & .or. itype(i+4).eq.ntyp1
2970 dx_normi=dc_norm(1,i)
2971 dy_normi=dc_norm(2,i)
2972 dz_normi=dc_norm(3,i)
2973 xmedi=c(1,i)+0.5d0*dxi
2974 ymedi=c(2,i)+0.5d0*dyi
2975 zmedi=c(3,i)+0.5d0*dzi
2976 xmedi=mod(xmedi,boxxsize)
2977 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2978 ymedi=mod(ymedi,boxysize)
2979 if (ymedi.lt.0) ymedi=ymedi+boxysize
2980 zmedi=mod(zmedi,boxzsize)
2981 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2983 call eelecij(i,i+2,ees,evdw1,eel_loc)
2984 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2985 num_cont_hb(i)=num_conti
2987 do i=iturn4_start,iturn4_end
2988 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2989 & .or. itype(i+3).eq.ntyp1
2990 & .or. itype(i+4).eq.ntyp1
2991 & .or. itype(i+5).eq.ntyp1
2992 & .or. itype(i).eq.ntyp1
2993 & .or. itype(i-1).eq.ntyp1
2998 dx_normi=dc_norm(1,i)
2999 dy_normi=dc_norm(2,i)
3000 dz_normi=dc_norm(3,i)
3001 xmedi=c(1,i)+0.5d0*dxi
3002 ymedi=c(2,i)+0.5d0*dyi
3003 zmedi=c(3,i)+0.5d0*dzi
3004 C Return atom into box, boxxsize is size of box in x dimension
3006 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3007 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3008 C Condition for being inside the proper box
3009 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3010 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3014 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3015 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3016 C Condition for being inside the proper box
3017 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3018 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3022 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3023 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3024 C Condition for being inside the proper box
3025 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3026 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3029 xmedi=mod(xmedi,boxxsize)
3030 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3031 ymedi=mod(ymedi,boxysize)
3032 if (ymedi.lt.0) ymedi=ymedi+boxysize
3033 zmedi=mod(zmedi,boxzsize)
3034 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3036 num_conti=num_cont_hb(i)
3037 call eelecij(i,i+3,ees,evdw1,eel_loc)
3038 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3039 & call eturn4(i,eello_turn4)
3040 num_cont_hb(i)=num_conti
3042 C Loop over all neighbouring boxes
3047 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3049 do i=iatel_s,iatel_e
3050 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3051 & .or. itype(i+2).eq.ntyp1
3052 & .or. itype(i-1).eq.ntyp1
3057 dx_normi=dc_norm(1,i)
3058 dy_normi=dc_norm(2,i)
3059 dz_normi=dc_norm(3,i)
3060 xmedi=c(1,i)+0.5d0*dxi
3061 ymedi=c(2,i)+0.5d0*dyi
3062 zmedi=c(3,i)+0.5d0*dzi
3063 xmedi=mod(xmedi,boxxsize)
3064 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3065 ymedi=mod(ymedi,boxysize)
3066 if (ymedi.lt.0) ymedi=ymedi+boxysize
3067 zmedi=mod(zmedi,boxzsize)
3068 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3069 C xmedi=xmedi+xshift*boxxsize
3070 C ymedi=ymedi+yshift*boxysize
3071 C zmedi=zmedi+zshift*boxzsize
3073 C Return tom into box, boxxsize is size of box in x dimension
3075 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3076 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3077 C Condition for being inside the proper box
3078 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3079 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3083 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3084 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3085 C Condition for being inside the proper box
3086 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3087 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3091 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3092 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3093 cC Condition for being inside the proper box
3094 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3095 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3099 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3100 num_conti=num_cont_hb(i)
3101 do j=ielstart(i),ielend(i)
3102 c write (iout,*) i,j,itype(i),itype(j)
3103 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3104 & .or.itype(j+2).eq.ntyp1
3105 & .or.itype(j-1).eq.ntyp1
3107 call eelecij(i,j,ees,evdw1,eel_loc)
3109 num_cont_hb(i)=num_conti
3115 c write (iout,*) "Number of loop steps in EELEC:",ind
3117 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3118 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3120 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3121 ccc eel_loc=eel_loc+eello_turn3
3122 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3125 C-------------------------------------------------------------------------------
3126 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3127 implicit real*8 (a-h,o-z)
3128 include 'DIMENSIONS'
3132 include 'COMMON.CONTROL'
3133 include 'COMMON.IOUNITS'
3134 include 'COMMON.GEO'
3135 include 'COMMON.VAR'
3136 include 'COMMON.LOCAL'
3137 include 'COMMON.CHAIN'
3138 include 'COMMON.DERIV'
3139 include 'COMMON.INTERACT'
3140 include 'COMMON.CONTACTS'
3141 include 'COMMON.TORSION'
3142 include 'COMMON.VECTORS'
3143 include 'COMMON.FFIELD'
3144 include 'COMMON.TIME1'
3145 include 'COMMON.SPLITELE'
3146 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3147 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3148 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3149 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3150 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3151 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3153 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3155 double precision scal_el /1.0d0/
3157 double precision scal_el /0.5d0/
3160 C 13-go grudnia roku pamietnego...
3161 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3162 & 0.0d0,1.0d0,0.0d0,
3163 & 0.0d0,0.0d0,1.0d0/
3164 c time00=MPI_Wtime()
3165 cd write (iout,*) "eelecij",i,j
3169 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3170 aaa=app(iteli,itelj)
3171 bbb=bpp(iteli,itelj)
3172 ael6i=ael6(iteli,itelj)
3173 ael3i=ael3(iteli,itelj)
3177 dx_normj=dc_norm(1,j)
3178 dy_normj=dc_norm(2,j)
3179 dz_normj=dc_norm(3,j)
3180 C xj=c(1,j)+0.5D0*dxj-xmedi
3181 C yj=c(2,j)+0.5D0*dyj-ymedi
3182 C zj=c(3,j)+0.5D0*dzj-zmedi
3187 if (xj.lt.0) xj=xj+boxxsize
3189 if (yj.lt.0) yj=yj+boxysize
3191 if (zj.lt.0) zj=zj+boxzsize
3192 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3193 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3201 xj=xj_safe+xshift*boxxsize
3202 yj=yj_safe+yshift*boxysize
3203 zj=zj_safe+zshift*boxzsize
3204 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3205 if(dist_temp.lt.dist_init) then
3215 if (isubchap.eq.1) then
3224 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3226 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3227 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3228 C Condition for being inside the proper box
3229 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3230 c & (xj.lt.((-0.5d0)*boxxsize))) then
3234 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3235 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3236 C Condition for being inside the proper box
3237 c if ((yj.gt.((0.5d0)*boxysize)).or.
3238 c & (yj.lt.((-0.5d0)*boxysize))) then
3242 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3243 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3244 C Condition for being inside the proper box
3245 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3246 c & (zj.lt.((-0.5d0)*boxzsize))) then
3249 C endif !endPBC condintion
3253 rij=xj*xj+yj*yj+zj*zj
3255 sss=sscale(sqrt(rij))
3256 sssgrad=sscagrad(sqrt(rij))
3257 c if (sss.gt.0.0d0) then
3263 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3264 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3265 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3266 fac=cosa-3.0D0*cosb*cosg
3268 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3269 if (j.eq.i+2) ev1=scal_el*ev1
3274 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3278 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3279 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3281 evdw1=evdw1+evdwij*sss
3282 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3283 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3284 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3285 cd & xmedi,ymedi,zmedi,xj,yj,zj
3287 if (energy_dec) then
3288 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3290 &,iteli,itelj,aaa,evdw1
3291 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3295 C Calculate contributions to the Cartesian gradient.
3298 facvdw=-6*rrmij*(ev1+evdwij)*sss
3299 facel=-3*rrmij*(el1+eesij)
3305 * Radial derivatives. First process both termini of the fragment (i,j)
3311 c ghalf=0.5D0*ggg(k)
3312 c gelc(k,i)=gelc(k,i)+ghalf
3313 c gelc(k,j)=gelc(k,j)+ghalf
3315 c 9/28/08 AL Gradient compotents will be summed only at the end
3317 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3318 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3321 * Loop over residues i+1 thru j-1.
3325 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3328 if (sss.gt.0.0) then
3329 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3330 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3331 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3338 c ghalf=0.5D0*ggg(k)
3339 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3340 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3342 c 9/28/08 AL Gradient compotents will be summed only at the end
3344 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3345 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3348 * Loop over residues i+1 thru j-1.
3352 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3357 facvdw=(ev1+evdwij)*sss
3360 fac=-3*rrmij*(facvdw+facvdw+facel)
3365 * Radial derivatives. First process both termini of the fragment (i,j)
3371 c ghalf=0.5D0*ggg(k)
3372 c gelc(k,i)=gelc(k,i)+ghalf
3373 c gelc(k,j)=gelc(k,j)+ghalf
3375 c 9/28/08 AL Gradient compotents will be summed only at the end
3377 gelc_long(k,j)=gelc(k,j)+ggg(k)
3378 gelc_long(k,i)=gelc(k,i)-ggg(k)
3381 * Loop over residues i+1 thru j-1.
3385 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3388 c 9/28/08 AL Gradient compotents will be summed only at the end
3389 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3390 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3391 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3393 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3394 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3400 ecosa=2.0D0*fac3*fac1+fac4
3403 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3404 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3406 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3407 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3409 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3410 cd & (dcosg(k),k=1,3)
3412 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3415 c ghalf=0.5D0*ggg(k)
3416 c gelc(k,i)=gelc(k,i)+ghalf
3417 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3418 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3419 c gelc(k,j)=gelc(k,j)+ghalf
3420 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3421 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3425 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3430 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3431 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3433 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3434 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3435 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3436 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3440 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3441 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3442 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3444 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3445 C energy of a peptide unit is assumed in the form of a second-order
3446 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3447 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3448 C are computed for EVERY pair of non-contiguous peptide groups.
3450 if (j.lt.nres-1) then
3461 muij(kkk)=mu(k,i)*mu(l,j)
3464 cd write (iout,*) 'EELEC: i',i,' j',j
3465 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3466 cd write(iout,*) 'muij',muij
3467 ury=scalar(uy(1,i),erij)
3468 urz=scalar(uz(1,i),erij)
3469 vry=scalar(uy(1,j),erij)
3470 vrz=scalar(uz(1,j),erij)
3471 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3472 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3473 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3474 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3475 fac=dsqrt(-ael6i)*r3ij
3480 cd write (iout,'(4i5,4f10.5)')
3481 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3482 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3483 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3484 cd & uy(:,j),uz(:,j)
3485 cd write (iout,'(4f10.5)')
3486 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3487 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3488 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3489 cd write (iout,'(9f10.5/)')
3490 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3491 C Derivatives of the elements of A in virtual-bond vectors
3492 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3494 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3495 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3496 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3497 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3498 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3499 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3500 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3501 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3502 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3503 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3504 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3505 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3507 C Compute radial contributions to the gradient
3525 C Add the contributions coming from er
3528 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3529 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3530 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3531 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3534 C Derivatives in DC(i)
3535 cgrad ghalf1=0.5d0*agg(k,1)
3536 cgrad ghalf2=0.5d0*agg(k,2)
3537 cgrad ghalf3=0.5d0*agg(k,3)
3538 cgrad ghalf4=0.5d0*agg(k,4)
3539 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3540 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3541 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3542 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3543 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3544 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3545 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3546 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3547 C Derivatives in DC(i+1)
3548 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3549 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3550 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3551 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3552 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3553 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3554 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3555 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3556 C Derivatives in DC(j)
3557 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3558 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3559 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3560 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3561 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3562 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3563 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3564 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3565 C Derivatives in DC(j+1) or DC(nres-1)
3566 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3567 & -3.0d0*vryg(k,3)*ury)
3568 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3569 & -3.0d0*vrzg(k,3)*ury)
3570 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3571 & -3.0d0*vryg(k,3)*urz)
3572 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3573 & -3.0d0*vrzg(k,3)*urz)
3574 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3576 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3589 aggi(k,l)=-aggi(k,l)
3590 aggi1(k,l)=-aggi1(k,l)
3591 aggj(k,l)=-aggj(k,l)
3592 aggj1(k,l)=-aggj1(k,l)
3595 if (j.lt.nres-1) then
3601 aggi(k,l)=-aggi(k,l)
3602 aggi1(k,l)=-aggi1(k,l)
3603 aggj(k,l)=-aggj(k,l)
3604 aggj1(k,l)=-aggj1(k,l)
3615 aggi(k,l)=-aggi(k,l)
3616 aggi1(k,l)=-aggi1(k,l)
3617 aggj(k,l)=-aggj(k,l)
3618 aggj1(k,l)=-aggj1(k,l)
3623 IF (wel_loc.gt.0.0d0) THEN
3624 C Contribution to the local-electrostatic energy coming from the i-j pair
3625 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3627 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3628 c & ' eel_loc_ij',eel_loc_ij
3630 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3631 & 'eelloc',i,j,eel_loc_ij
3632 c if (eel_loc_ij.ne.0)
3633 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3634 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3636 eel_loc=eel_loc+eel_loc_ij
3637 C Partial derivatives in virtual-bond dihedral angles gamma
3639 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3640 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3641 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3642 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3643 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3644 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3645 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3647 ggg(l)=agg(l,1)*muij(1)+
3648 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3649 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3650 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3651 cgrad ghalf=0.5d0*ggg(l)
3652 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3653 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3657 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3660 C Remaining derivatives of eello
3662 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3663 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3664 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3665 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3666 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3667 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3668 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3669 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3672 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3673 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3674 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3675 & .and. num_conti.le.maxconts) then
3676 c write (iout,*) i,j," entered corr"
3678 C Calculate the contact function. The ith column of the array JCONT will
3679 C contain the numbers of atoms that make contacts with the atom I (of numbers
3680 C greater than I). The arrays FACONT and GACONT will contain the values of
3681 C the contact function and its derivative.
3682 c r0ij=1.02D0*rpp(iteli,itelj)
3683 c r0ij=1.11D0*rpp(iteli,itelj)
3684 r0ij=2.20D0*rpp(iteli,itelj)
3685 c r0ij=1.55D0*rpp(iteli,itelj)
3686 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3687 if (fcont.gt.0.0D0) then
3688 num_conti=num_conti+1
3689 if (num_conti.gt.maxconts) then
3690 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3691 & ' will skip next contacts for this conf.'
3693 jcont_hb(num_conti,i)=j
3694 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3695 cd & " jcont_hb",jcont_hb(num_conti,i)
3696 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3697 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3698 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3700 d_cont(num_conti,i)=rij
3701 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3702 C --- Electrostatic-interaction matrix ---
3703 a_chuj(1,1,num_conti,i)=a22
3704 a_chuj(1,2,num_conti,i)=a23
3705 a_chuj(2,1,num_conti,i)=a32
3706 a_chuj(2,2,num_conti,i)=a33
3707 C --- Gradient of rij
3709 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3716 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3717 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3718 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3719 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3720 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3725 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3726 C Calculate contact energies
3728 wij=cosa-3.0D0*cosb*cosg
3731 c fac3=dsqrt(-ael6i)/r0ij**3
3732 fac3=dsqrt(-ael6i)*r3ij
3733 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3734 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3735 if (ees0tmp.gt.0) then
3736 ees0pij=dsqrt(ees0tmp)
3740 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3741 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3742 if (ees0tmp.gt.0) then
3743 ees0mij=dsqrt(ees0tmp)
3748 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3749 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3750 C Diagnostics. Comment out or remove after debugging!
3751 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3752 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3753 c ees0m(num_conti,i)=0.0D0
3755 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3756 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3757 C Angular derivatives of the contact function
3758 ees0pij1=fac3/ees0pij
3759 ees0mij1=fac3/ees0mij
3760 fac3p=-3.0D0*fac3*rrmij
3761 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3762 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3764 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3765 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3766 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3767 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3768 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3769 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3770 ecosap=ecosa1+ecosa2
3771 ecosbp=ecosb1+ecosb2
3772 ecosgp=ecosg1+ecosg2
3773 ecosam=ecosa1-ecosa2
3774 ecosbm=ecosb1-ecosb2
3775 ecosgm=ecosg1-ecosg2
3784 facont_hb(num_conti,i)=fcont
3785 fprimcont=fprimcont/rij
3786 cd facont_hb(num_conti,i)=1.0D0
3787 C Following line is for diagnostics.
3790 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3791 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3794 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3795 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3797 gggp(1)=gggp(1)+ees0pijp*xj
3798 gggp(2)=gggp(2)+ees0pijp*yj
3799 gggp(3)=gggp(3)+ees0pijp*zj
3800 gggm(1)=gggm(1)+ees0mijp*xj
3801 gggm(2)=gggm(2)+ees0mijp*yj
3802 gggm(3)=gggm(3)+ees0mijp*zj
3803 C Derivatives due to the contact function
3804 gacont_hbr(1,num_conti,i)=fprimcont*xj
3805 gacont_hbr(2,num_conti,i)=fprimcont*yj
3806 gacont_hbr(3,num_conti,i)=fprimcont*zj
3809 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3810 c following the change of gradient-summation algorithm.
3812 cgrad ghalfp=0.5D0*gggp(k)
3813 cgrad ghalfm=0.5D0*gggm(k)
3814 gacontp_hb1(k,num_conti,i)=!ghalfp
3815 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3816 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3817 gacontp_hb2(k,num_conti,i)=!ghalfp
3818 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3819 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3820 gacontp_hb3(k,num_conti,i)=gggp(k)
3821 gacontm_hb1(k,num_conti,i)=!ghalfm
3822 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3823 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3824 gacontm_hb2(k,num_conti,i)=!ghalfm
3825 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3826 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3827 gacontm_hb3(k,num_conti,i)=gggm(k)
3829 C Diagnostics. Comment out or remove after debugging!
3831 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3832 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3833 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3834 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3835 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3836 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3839 endif ! num_conti.le.maxconts
3842 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3845 ghalf=0.5d0*agg(l,k)
3846 aggi(l,k)=aggi(l,k)+ghalf
3847 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3848 aggj(l,k)=aggj(l,k)+ghalf
3851 if (j.eq.nres-1 .and. i.lt.j-2) then
3854 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3859 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3862 C-----------------------------------------------------------------------------
3863 subroutine eturn3(i,eello_turn3)
3864 C Third- and fourth-order contributions from turns
3865 implicit real*8 (a-h,o-z)
3866 include 'DIMENSIONS'
3867 include 'COMMON.IOUNITS'
3868 include 'COMMON.GEO'
3869 include 'COMMON.VAR'
3870 include 'COMMON.LOCAL'
3871 include 'COMMON.CHAIN'
3872 include 'COMMON.DERIV'
3873 include 'COMMON.INTERACT'
3874 include 'COMMON.CONTACTS'
3875 include 'COMMON.TORSION'
3876 include 'COMMON.VECTORS'
3877 include 'COMMON.FFIELD'
3878 include 'COMMON.CONTROL'
3880 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3881 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3882 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3883 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3884 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3885 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3886 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3889 c write (iout,*) "eturn3",i,j,j1,j2
3894 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3896 C Third-order contributions
3903 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3904 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3905 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3906 call transpose2(auxmat(1,1),auxmat1(1,1))
3907 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3908 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3909 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3910 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3911 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3912 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3913 cd & ' eello_turn3_num',4*eello_turn3_num
3914 C Derivatives in gamma(i)
3915 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3916 call transpose2(auxmat2(1,1),auxmat3(1,1))
3917 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3918 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3919 C Derivatives in gamma(i+1)
3920 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3921 call transpose2(auxmat2(1,1),auxmat3(1,1))
3922 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3923 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3924 & +0.5d0*(pizda(1,1)+pizda(2,2))
3925 C Cartesian derivatives
3927 c ghalf1=0.5d0*agg(l,1)
3928 c ghalf2=0.5d0*agg(l,2)
3929 c ghalf3=0.5d0*agg(l,3)
3930 c ghalf4=0.5d0*agg(l,4)
3931 a_temp(1,1)=aggi(l,1)!+ghalf1
3932 a_temp(1,2)=aggi(l,2)!+ghalf2
3933 a_temp(2,1)=aggi(l,3)!+ghalf3
3934 a_temp(2,2)=aggi(l,4)!+ghalf4
3935 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3936 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3937 & +0.5d0*(pizda(1,1)+pizda(2,2))
3938 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3939 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3940 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3941 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3942 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3943 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3944 & +0.5d0*(pizda(1,1)+pizda(2,2))
3945 a_temp(1,1)=aggj(l,1)!+ghalf1
3946 a_temp(1,2)=aggj(l,2)!+ghalf2
3947 a_temp(2,1)=aggj(l,3)!+ghalf3
3948 a_temp(2,2)=aggj(l,4)!+ghalf4
3949 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3950 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3951 & +0.5d0*(pizda(1,1)+pizda(2,2))
3952 a_temp(1,1)=aggj1(l,1)
3953 a_temp(1,2)=aggj1(l,2)
3954 a_temp(2,1)=aggj1(l,3)
3955 a_temp(2,2)=aggj1(l,4)
3956 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3957 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3958 & +0.5d0*(pizda(1,1)+pizda(2,2))
3962 C-------------------------------------------------------------------------------
3963 subroutine eturn4(i,eello_turn4)
3964 C Third- and fourth-order contributions from turns
3965 implicit real*8 (a-h,o-z)
3966 include 'DIMENSIONS'
3967 include 'COMMON.IOUNITS'
3968 include 'COMMON.GEO'
3969 include 'COMMON.VAR'
3970 include 'COMMON.LOCAL'
3971 include 'COMMON.CHAIN'
3972 include 'COMMON.DERIV'
3973 include 'COMMON.INTERACT'
3974 include 'COMMON.CONTACTS'
3975 include 'COMMON.TORSION'
3976 include 'COMMON.VECTORS'
3977 include 'COMMON.FFIELD'
3978 include 'COMMON.CONTROL'
3980 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3981 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3982 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3983 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3984 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3985 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3986 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3989 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3991 C Fourth-order contributions
3999 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4000 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4001 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4006 iti1=itortyp(itype(i+1))
4007 iti2=itortyp(itype(i+2))
4008 iti3=itortyp(itype(i+3))
4009 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4010 call transpose2(EUg(1,1,i+1),e1t(1,1))
4011 call transpose2(Eug(1,1,i+2),e2t(1,1))
4012 call transpose2(Eug(1,1,i+3),e3t(1,1))
4013 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4014 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4015 s1=scalar2(b1(1,iti2),auxvec(1))
4016 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4017 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4018 s2=scalar2(b1(1,iti1),auxvec(1))
4019 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4020 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4021 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4022 eello_turn4=eello_turn4-(s1+s2+s3)
4023 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4024 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4025 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4026 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4027 cd & ' eello_turn4_num',8*eello_turn4_num
4028 C Derivatives in gamma(i)
4029 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4030 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4031 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4032 s1=scalar2(b1(1,iti2),auxvec(1))
4033 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4034 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4035 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4036 C Derivatives in gamma(i+1)
4037 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4038 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4039 s2=scalar2(b1(1,iti1),auxvec(1))
4040 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4041 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4042 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4043 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4044 C Derivatives in gamma(i+2)
4045 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4046 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4047 s1=scalar2(b1(1,iti2),auxvec(1))
4048 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4049 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4050 s2=scalar2(b1(1,iti1),auxvec(1))
4051 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4052 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4053 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4054 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4055 C Cartesian derivatives
4056 C Derivatives of this turn contributions in DC(i+2)
4057 if (j.lt.nres-1) then
4059 a_temp(1,1)=agg(l,1)
4060 a_temp(1,2)=agg(l,2)
4061 a_temp(2,1)=agg(l,3)
4062 a_temp(2,2)=agg(l,4)
4063 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4064 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4065 s1=scalar2(b1(1,iti2),auxvec(1))
4066 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4067 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4068 s2=scalar2(b1(1,iti1),auxvec(1))
4069 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4070 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4071 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4073 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4076 C Remaining derivatives of this turn contribution
4078 a_temp(1,1)=aggi(l,1)
4079 a_temp(1,2)=aggi(l,2)
4080 a_temp(2,1)=aggi(l,3)
4081 a_temp(2,2)=aggi(l,4)
4082 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4083 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4084 s1=scalar2(b1(1,iti2),auxvec(1))
4085 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4086 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4087 s2=scalar2(b1(1,iti1),auxvec(1))
4088 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4089 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4090 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4091 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4092 a_temp(1,1)=aggi1(l,1)
4093 a_temp(1,2)=aggi1(l,2)
4094 a_temp(2,1)=aggi1(l,3)
4095 a_temp(2,2)=aggi1(l,4)
4096 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4097 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4098 s1=scalar2(b1(1,iti2),auxvec(1))
4099 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4100 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4101 s2=scalar2(b1(1,iti1),auxvec(1))
4102 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4103 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4104 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4105 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4106 a_temp(1,1)=aggj(l,1)
4107 a_temp(1,2)=aggj(l,2)
4108 a_temp(2,1)=aggj(l,3)
4109 a_temp(2,2)=aggj(l,4)
4110 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4111 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4112 s1=scalar2(b1(1,iti2),auxvec(1))
4113 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4114 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4115 s2=scalar2(b1(1,iti1),auxvec(1))
4116 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4117 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4118 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4119 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4120 a_temp(1,1)=aggj1(l,1)
4121 a_temp(1,2)=aggj1(l,2)
4122 a_temp(2,1)=aggj1(l,3)
4123 a_temp(2,2)=aggj1(l,4)
4124 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4125 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4126 s1=scalar2(b1(1,iti2),auxvec(1))
4127 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4128 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4129 s2=scalar2(b1(1,iti1),auxvec(1))
4130 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4131 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4132 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4133 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4134 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4138 C-----------------------------------------------------------------------------
4139 subroutine vecpr(u,v,w)
4140 implicit real*8(a-h,o-z)
4141 dimension u(3),v(3),w(3)
4142 w(1)=u(2)*v(3)-u(3)*v(2)
4143 w(2)=-u(1)*v(3)+u(3)*v(1)
4144 w(3)=u(1)*v(2)-u(2)*v(1)
4147 C-----------------------------------------------------------------------------
4148 subroutine unormderiv(u,ugrad,unorm,ungrad)
4149 C This subroutine computes the derivatives of a normalized vector u, given
4150 C the derivatives computed without normalization conditions, ugrad. Returns
4153 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4154 double precision vec(3)
4155 double precision scalar
4157 c write (2,*) 'ugrad',ugrad
4160 vec(i)=scalar(ugrad(1,i),u(1))
4162 c write (2,*) 'vec',vec
4165 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4168 c write (2,*) 'ungrad',ungrad
4171 C-----------------------------------------------------------------------------
4172 subroutine escp_soft_sphere(evdw2,evdw2_14)
4174 C This subroutine calculates the excluded-volume interaction energy between
4175 C peptide-group centers and side chains and its gradient in virtual-bond and
4176 C side-chain vectors.
4178 implicit real*8 (a-h,o-z)
4179 include 'DIMENSIONS'
4180 include 'COMMON.GEO'
4181 include 'COMMON.VAR'
4182 include 'COMMON.LOCAL'
4183 include 'COMMON.CHAIN'
4184 include 'COMMON.DERIV'
4185 include 'COMMON.INTERACT'
4186 include 'COMMON.FFIELD'
4187 include 'COMMON.IOUNITS'
4188 include 'COMMON.CONTROL'
4193 cd print '(a)','Enter ESCP'
4194 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4198 do i=iatscp_s,iatscp_e
4199 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4201 xi=0.5D0*(c(1,i)+c(1,i+1))
4202 yi=0.5D0*(c(2,i)+c(2,i+1))
4203 zi=0.5D0*(c(3,i)+c(3,i+1))
4204 C Return atom into box, boxxsize is size of box in x dimension
4206 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4207 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4208 C Condition for being inside the proper box
4209 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4210 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4214 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4215 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4216 C Condition for being inside the proper box
4217 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4218 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4222 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4223 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4224 cC Condition for being inside the proper box
4225 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4226 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4230 if (xi.lt.0) xi=xi+boxxsize
4232 if (yi.lt.0) yi=yi+boxysize
4234 if (zi.lt.0) zi=zi+boxzsize
4235 C xi=xi+xshift*boxxsize
4236 C yi=yi+yshift*boxysize
4237 C zi=zi+zshift*boxzsize
4238 do iint=1,nscp_gr(i)
4240 do j=iscpstart(i,iint),iscpend(i,iint)
4241 if (itype(j).eq.ntyp1) cycle
4242 itypj=iabs(itype(j))
4243 C Uncomment following three lines for SC-p interactions
4247 C Uncomment following three lines for Ca-p interactions
4252 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4253 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4254 C Condition for being inside the proper box
4255 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4256 c & (xj.lt.((-0.5d0)*boxxsize))) then
4260 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4261 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4262 cC Condition for being inside the proper box
4263 c if ((yj.gt.((0.5d0)*boxysize)).or.
4264 c & (yj.lt.((-0.5d0)*boxysize))) then
4268 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4269 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4270 C Condition for being inside the proper box
4271 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4272 c & (zj.lt.((-0.5d0)*boxzsize))) then
4275 if (xj.lt.0) xj=xj+boxxsize
4277 if (yj.lt.0) yj=yj+boxysize
4279 if (zj.lt.0) zj=zj+boxzsize
4280 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4288 xj=xj_safe+xshift*boxxsize
4289 yj=yj_safe+yshift*boxysize
4290 zj=zj_safe+zshift*boxzsize
4291 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4292 if(dist_temp.lt.dist_init) then
4302 if (subchap.eq.1) then
4315 rij=xj*xj+yj*yj+zj*zj
4319 if (rij.lt.r0ijsq) then
4320 evdwij=0.25d0*(rij-r0ijsq)**2
4328 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4333 cgrad if (j.lt.i) then
4334 cd write (iout,*) 'j<i'
4335 C Uncomment following three lines for SC-p interactions
4337 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4340 cd write (iout,*) 'j>i'
4342 cgrad ggg(k)=-ggg(k)
4343 C Uncomment following line for SC-p interactions
4344 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4348 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4350 cgrad kstart=min0(i+1,j)
4351 cgrad kend=max0(i-1,j-1)
4352 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4353 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4354 cgrad do k=kstart,kend
4356 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4360 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4361 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4372 C-----------------------------------------------------------------------------
4373 subroutine escp(evdw2,evdw2_14)
4375 C This subroutine calculates the excluded-volume interaction energy between
4376 C peptide-group centers and side chains and its gradient in virtual-bond and
4377 C side-chain vectors.
4379 implicit real*8 (a-h,o-z)
4380 include 'DIMENSIONS'
4381 include 'COMMON.GEO'
4382 include 'COMMON.VAR'
4383 include 'COMMON.LOCAL'
4384 include 'COMMON.CHAIN'
4385 include 'COMMON.DERIV'
4386 include 'COMMON.INTERACT'
4387 include 'COMMON.FFIELD'
4388 include 'COMMON.IOUNITS'
4389 include 'COMMON.CONTROL'
4390 include 'COMMON.SPLITELE'
4394 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
4395 cd print '(a)','Enter ESCP'
4396 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4400 do i=iatscp_s,iatscp_e
4401 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4403 xi=0.5D0*(c(1,i)+c(1,i+1))
4404 yi=0.5D0*(c(2,i)+c(2,i+1))
4405 zi=0.5D0*(c(3,i)+c(3,i+1))
4407 if (xi.lt.0) xi=xi+boxxsize
4409 if (yi.lt.0) yi=yi+boxysize
4411 if (zi.lt.0) zi=zi+boxzsize
4412 c xi=xi+xshift*boxxsize
4413 c yi=yi+yshift*boxysize
4414 c zi=zi+zshift*boxzsize
4415 c print *,xi,yi,zi,'polozenie i'
4416 C Return atom into box, boxxsize is size of box in x dimension
4418 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4419 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4420 C Condition for being inside the proper box
4421 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4422 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4426 c print *,xi,boxxsize,"pierwszy"
4428 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4429 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4430 C Condition for being inside the proper box
4431 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4432 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4436 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4437 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4438 C Condition for being inside the proper box
4439 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4440 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4443 do iint=1,nscp_gr(i)
4445 do j=iscpstart(i,iint),iscpend(i,iint)
4446 itypj=iabs(itype(j))
4447 if (itypj.eq.ntyp1) cycle
4448 C Uncomment following three lines for SC-p interactions
4452 C Uncomment following three lines for Ca-p interactions
4457 if (xj.lt.0) xj=xj+boxxsize
4459 if (yj.lt.0) yj=yj+boxysize
4461 if (zj.lt.0) zj=zj+boxzsize
4463 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4464 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4465 C Condition for being inside the proper box
4466 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4467 c & (xj.lt.((-0.5d0)*boxxsize))) then
4471 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4472 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4473 cC Condition for being inside the proper box
4474 c if ((yj.gt.((0.5d0)*boxysize)).or.
4475 c & (yj.lt.((-0.5d0)*boxysize))) then
4479 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4480 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4481 C Condition for being inside the proper box
4482 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4483 c & (zj.lt.((-0.5d0)*boxzsize))) then
4486 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
4487 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4495 xj=xj_safe+xshift*boxxsize
4496 yj=yj_safe+yshift*boxysize
4497 zj=zj_safe+zshift*boxzsize
4498 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4499 if(dist_temp.lt.dist_init) then
4509 if (subchap.eq.1) then
4518 c print *,xj,yj,zj,'polozenie j'
4519 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4521 sss=sscale(1.0d0/(dsqrt(rrij)))
4522 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
4523 c if (sss.eq.0) print *,'czasem jest OK'
4524 if (sss.le.0.0d0) cycle
4525 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4527 e1=fac*fac*aad(itypj,iteli)
4528 e2=fac*bad(itypj,iteli)
4529 if (iabs(j-i) .le. 2) then
4532 evdw2_14=evdw2_14+(e1+e2)*sss
4535 evdw2=evdw2+evdwij*sss
4536 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4537 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4540 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4542 fac=-(evdwij+e1)*rrij*sss
4543 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4547 cgrad if (j.lt.i) then
4548 cd write (iout,*) 'j<i'
4549 C Uncomment following three lines for SC-p interactions
4551 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4554 cd write (iout,*) 'j>i'
4556 cgrad ggg(k)=-ggg(k)
4557 C Uncomment following line for SC-p interactions
4558 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4559 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4563 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4565 cgrad kstart=min0(i+1,j)
4566 cgrad kend=max0(i-1,j-1)
4567 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4568 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4569 cgrad do k=kstart,kend
4571 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4575 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4576 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4578 c endif !endif for sscale cutoff
4588 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4589 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4590 gradx_scp(j,i)=expon*gradx_scp(j,i)
4593 C******************************************************************************
4597 C To save time the factor EXPON has been extracted from ALL components
4598 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4601 C******************************************************************************
4604 C--------------------------------------------------------------------------
4605 subroutine edis(ehpb)
4607 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4609 implicit real*8 (a-h,o-z)
4610 include 'DIMENSIONS'
4611 include 'COMMON.SBRIDGE'
4612 include 'COMMON.CHAIN'
4613 include 'COMMON.DERIV'
4614 include 'COMMON.VAR'
4615 include 'COMMON.INTERACT'
4616 include 'COMMON.IOUNITS'
4619 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4620 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4621 if (link_end.eq.0) return
4622 do i=link_start,link_end
4623 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4624 C CA-CA distance used in regularization of structure.
4627 C iii and jjj point to the residues for which the distance is assigned.
4628 if (ii.gt.nres) then
4635 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4636 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4637 C distance and angle dependent SS bond potential.
4638 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4639 & iabs(itype(jjj)).eq.1) then
4640 call ssbond_ene(iii,jjj,eij)
4642 cd write (iout,*) "eij",eij
4644 C Calculate the distance between the two points and its difference from the
4648 C Get the force constant corresponding to this distance.
4650 C Calculate the contribution to energy.
4651 ehpb=ehpb+waga*rdis*rdis
4653 C Evaluate gradient.
4656 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4657 cd & ' waga=',waga,' fac=',fac
4659 ggg(j)=fac*(c(j,jj)-c(j,ii))
4661 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4662 C If this is a SC-SC distance, we need to calculate the contributions to the
4663 C Cartesian gradient in the SC vectors (ghpbx).
4666 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4667 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4670 cgrad do j=iii,jjj-1
4672 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4676 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4677 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4684 C--------------------------------------------------------------------------
4685 subroutine ssbond_ene(i,j,eij)
4687 C Calculate the distance and angle dependent SS-bond potential energy
4688 C using a free-energy function derived based on RHF/6-31G** ab initio
4689 C calculations of diethyl disulfide.
4691 C A. Liwo and U. Kozlowska, 11/24/03
4693 implicit real*8 (a-h,o-z)
4694 include 'DIMENSIONS'
4695 include 'COMMON.SBRIDGE'
4696 include 'COMMON.CHAIN'
4697 include 'COMMON.DERIV'
4698 include 'COMMON.LOCAL'
4699 include 'COMMON.INTERACT'
4700 include 'COMMON.VAR'
4701 include 'COMMON.IOUNITS'
4702 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4703 itypi=iabs(itype(i))
4707 dxi=dc_norm(1,nres+i)
4708 dyi=dc_norm(2,nres+i)
4709 dzi=dc_norm(3,nres+i)
4710 c dsci_inv=dsc_inv(itypi)
4711 dsci_inv=vbld_inv(nres+i)
4712 itypj=iabs(itype(j))
4713 c dscj_inv=dsc_inv(itypj)
4714 dscj_inv=vbld_inv(nres+j)
4718 dxj=dc_norm(1,nres+j)
4719 dyj=dc_norm(2,nres+j)
4720 dzj=dc_norm(3,nres+j)
4721 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4726 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4727 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4728 om12=dxi*dxj+dyi*dyj+dzi*dzj
4730 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4731 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4737 deltat12=om2-om1+2.0d0
4739 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4740 & +akct*deltad*deltat12
4741 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4742 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4743 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4744 c & " deltat12",deltat12," eij",eij
4745 ed=2*akcm*deltad+akct*deltat12
4747 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4748 eom1=-2*akth*deltat1-pom1-om2*pom2
4749 eom2= 2*akth*deltat2+pom1-om1*pom2
4752 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4753 ghpbx(k,i)=ghpbx(k,i)-ggk
4754 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4755 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4756 ghpbx(k,j)=ghpbx(k,j)+ggk
4757 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4758 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4759 ghpbc(k,i)=ghpbc(k,i)-ggk
4760 ghpbc(k,j)=ghpbc(k,j)+ggk
4763 C Calculate the components of the gradient in DC and X
4767 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4772 C--------------------------------------------------------------------------
4773 subroutine ebond(estr)
4775 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4777 implicit real*8 (a-h,o-z)
4778 include 'DIMENSIONS'
4779 include 'COMMON.LOCAL'
4780 include 'COMMON.GEO'
4781 include 'COMMON.INTERACT'
4782 include 'COMMON.DERIV'
4783 include 'COMMON.VAR'
4784 include 'COMMON.CHAIN'
4785 include 'COMMON.IOUNITS'
4786 include 'COMMON.NAMES'
4787 include 'COMMON.FFIELD'
4788 include 'COMMON.CONTROL'
4789 include 'COMMON.SETUP'
4790 double precision u(3),ud(3)
4793 do i=ibondp_start,ibondp_end
4794 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4795 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4797 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4798 c & *dc(j,i-1)/vbld(i)
4800 c if (energy_dec) write(iout,*)
4801 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4803 C Checking if it involves dummy (NH3+ or COO-) group
4804 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4805 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
4806 diff = vbld(i)-vbldpDUM
4808 C NO vbldp0 is the equlibrium lenght of spring for peptide group
4809 diff = vbld(i)-vbldp0
4811 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
4812 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4815 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4817 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4820 estr=0.5d0*AKP*estr+estr1
4822 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4824 do i=ibond_start,ibond_end
4826 if (iti.ne.10 .and. iti.ne.ntyp1) then
4829 diff=vbld(i+nres)-vbldsc0(1,iti)
4830 if (energy_dec) write (iout,*)
4831 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4832 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4833 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4835 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4839 diff=vbld(i+nres)-vbldsc0(j,iti)
4840 ud(j)=aksc(j,iti)*diff
4841 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4855 uprod2=uprod2*u(k)*u(k)
4859 usumsqder=usumsqder+ud(j)*uprod2
4861 estr=estr+uprod/usum
4863 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4871 C--------------------------------------------------------------------------
4872 subroutine ebend(etheta)
4874 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4875 C angles gamma and its derivatives in consecutive thetas and gammas.
4877 implicit real*8 (a-h,o-z)
4878 include 'DIMENSIONS'
4879 include 'COMMON.LOCAL'
4880 include 'COMMON.GEO'
4881 include 'COMMON.INTERACT'
4882 include 'COMMON.DERIV'
4883 include 'COMMON.VAR'
4884 include 'COMMON.CHAIN'
4885 include 'COMMON.IOUNITS'
4886 include 'COMMON.NAMES'
4887 include 'COMMON.FFIELD'
4888 include 'COMMON.CONTROL'
4889 common /calcthet/ term1,term2,termm,diffak,ratak,
4890 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4891 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4892 double precision y(2),z(2)
4894 c time11=dexp(-2*time)
4897 c write (*,'(a,i2)') 'EBEND ICG=',icg
4898 do i=ithet_start,ithet_end
4899 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4900 & .or.itype(i).eq.ntyp1) cycle
4901 C Zero the energy function and its derivative at 0 or pi.
4902 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4904 ichir1=isign(1,itype(i-2))
4905 ichir2=isign(1,itype(i))
4906 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4907 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4908 if (itype(i-1).eq.10) then
4909 itype1=isign(10,itype(i-2))
4910 ichir11=isign(1,itype(i-2))
4911 ichir12=isign(1,itype(i-2))
4912 itype2=isign(10,itype(i))
4913 ichir21=isign(1,itype(i))
4914 ichir22=isign(1,itype(i))
4917 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4920 if (phii.ne.phii) phii=150.0
4930 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4933 if (phii1.ne.phii1) phii1=150.0
4945 C Calculate the "mean" value of theta from the part of the distribution
4946 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4947 C In following comments this theta will be referred to as t_c.
4948 thet_pred_mean=0.0d0
4950 athetk=athet(k,it,ichir1,ichir2)
4951 bthetk=bthet(k,it,ichir1,ichir2)
4953 athetk=athet(k,itype1,ichir11,ichir12)
4954 bthetk=bthet(k,itype2,ichir21,ichir22)
4956 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4957 c write(iout,*) 'chuj tu', y(k),z(k)
4959 dthett=thet_pred_mean*ssd
4960 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4961 C Derivatives of the "mean" values in gamma1 and gamma2.
4962 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4963 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4964 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4965 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4967 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4968 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4969 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4970 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4972 if (theta(i).gt.pi-delta) then
4973 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4975 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4976 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4977 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4979 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4981 else if (theta(i).lt.delta) then
4982 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4983 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4984 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4986 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4987 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4990 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4993 etheta=etheta+ethetai
4994 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4995 & 'ebend',i,ethetai,theta(i),itype(i)
4996 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4997 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4998 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5000 C Ufff.... We've done all this!!!
5003 C---------------------------------------------------------------------------
5004 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5006 implicit real*8 (a-h,o-z)
5007 include 'DIMENSIONS'
5008 include 'COMMON.LOCAL'
5009 include 'COMMON.IOUNITS'
5010 common /calcthet/ term1,term2,termm,diffak,ratak,
5011 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5012 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5013 C Calculate the contributions to both Gaussian lobes.
5014 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5015 C The "polynomial part" of the "standard deviation" of this part of
5016 C the distributioni.
5017 ccc write (iout,*) thetai,thet_pred_mean
5020 sig=sig*thet_pred_mean+polthet(j,it)
5022 C Derivative of the "interior part" of the "standard deviation of the"
5023 C gamma-dependent Gaussian lobe in t_c.
5024 sigtc=3*polthet(3,it)
5026 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5029 C Set the parameters of both Gaussian lobes of the distribution.
5030 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5031 fac=sig*sig+sigc0(it)
5034 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5035 sigsqtc=-4.0D0*sigcsq*sigtc
5036 c print *,i,sig,sigtc,sigsqtc
5037 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5038 sigtc=-sigtc/(fac*fac)
5039 C Following variable is sigma(t_c)**(-2)
5040 sigcsq=sigcsq*sigcsq
5042 sig0inv=1.0D0/sig0i**2
5043 delthec=thetai-thet_pred_mean
5044 delthe0=thetai-theta0i
5045 term1=-0.5D0*sigcsq*delthec*delthec
5046 term2=-0.5D0*sig0inv*delthe0*delthe0
5047 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5048 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5049 C NaNs in taking the logarithm. We extract the largest exponent which is added
5050 C to the energy (this being the log of the distribution) at the end of energy
5051 C term evaluation for this virtual-bond angle.
5052 if (term1.gt.term2) then
5054 term2=dexp(term2-termm)
5058 term1=dexp(term1-termm)
5061 C The ratio between the gamma-independent and gamma-dependent lobes of
5062 C the distribution is a Gaussian function of thet_pred_mean too.
5063 diffak=gthet(2,it)-thet_pred_mean
5064 ratak=diffak/gthet(3,it)**2
5065 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5066 C Let's differentiate it in thet_pred_mean NOW.
5068 C Now put together the distribution terms to make complete distribution.
5069 termexp=term1+ak*term2
5070 termpre=sigc+ak*sig0i
5071 C Contribution of the bending energy from this theta is just the -log of
5072 C the sum of the contributions from the two lobes and the pre-exponential
5073 C factor. Simple enough, isn't it?
5074 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5075 C write (iout,*) 'termexp',termexp,termm,termpre,i
5076 C NOW the derivatives!!!
5077 C 6/6/97 Take into account the deformation.
5078 E_theta=(delthec*sigcsq*term1
5079 & +ak*delthe0*sig0inv*term2)/termexp
5080 E_tc=((sigtc+aktc*sig0i)/termpre
5081 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5082 & aktc*term2)/termexp)
5085 c-----------------------------------------------------------------------------
5086 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5087 implicit real*8 (a-h,o-z)
5088 include 'DIMENSIONS'
5089 include 'COMMON.LOCAL'
5090 include 'COMMON.IOUNITS'
5091 common /calcthet/ term1,term2,termm,diffak,ratak,
5092 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5093 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5094 delthec=thetai-thet_pred_mean
5095 delthe0=thetai-theta0i
5096 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5097 t3 = thetai-thet_pred_mean
5101 t14 = t12+t6*sigsqtc
5103 t21 = thetai-theta0i
5109 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5110 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5111 & *(-t12*t9-ak*sig0inv*t27)
5115 C--------------------------------------------------------------------------
5116 subroutine ebend(etheta)
5118 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5119 C angles gamma and its derivatives in consecutive thetas and gammas.
5120 C ab initio-derived potentials from
5121 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5123 implicit real*8 (a-h,o-z)
5124 include 'DIMENSIONS'
5125 include 'COMMON.LOCAL'
5126 include 'COMMON.GEO'
5127 include 'COMMON.INTERACT'
5128 include 'COMMON.DERIV'
5129 include 'COMMON.VAR'
5130 include 'COMMON.CHAIN'
5131 include 'COMMON.IOUNITS'
5132 include 'COMMON.NAMES'
5133 include 'COMMON.FFIELD'
5134 include 'COMMON.CONTROL'
5135 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5136 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5137 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5138 & sinph1ph2(maxdouble,maxdouble)
5139 logical lprn /.false./, lprn1 /.false./
5141 do i=ithet_start,ithet_end
5142 c print *,i,itype(i-1),itype(i),itype(i-2)
5143 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5144 & .or.itype(i).eq.ntyp1) cycle
5145 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
5147 if (iabs(itype(i+1)).eq.20) iblock=2
5148 if (iabs(itype(i+1)).ne.20) iblock=1
5152 theti2=0.5d0*theta(i)
5153 ityp2=ithetyp((itype(i-1)))
5155 coskt(k)=dcos(k*theti2)
5156 sinkt(k)=dsin(k*theti2)
5158 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5161 if (phii.ne.phii) phii=150.0
5165 ityp1=ithetyp((itype(i-2)))
5166 C propagation of chirality for glycine type
5168 cosph1(k)=dcos(k*phii)
5169 sinph1(k)=dsin(k*phii)
5179 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5182 if (phii1.ne.phii1) phii1=150.0
5187 ityp3=ithetyp((itype(i)))
5189 cosph2(k)=dcos(k*phii1)
5190 sinph2(k)=dsin(k*phii1)
5200 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5203 ccl=cosph1(l)*cosph2(k-l)
5204 ssl=sinph1(l)*sinph2(k-l)
5205 scl=sinph1(l)*cosph2(k-l)
5206 csl=cosph1(l)*sinph2(k-l)
5207 cosph1ph2(l,k)=ccl-ssl
5208 cosph1ph2(k,l)=ccl+ssl
5209 sinph1ph2(l,k)=scl+csl
5210 sinph1ph2(k,l)=scl-csl
5214 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5215 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5216 write (iout,*) "coskt and sinkt"
5218 write (iout,*) k,coskt(k),sinkt(k)
5222 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5223 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5226 & write (iout,*) "k",k,"
5227 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5228 & " ethetai",ethetai
5231 write (iout,*) "cosph and sinph"
5233 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5235 write (iout,*) "cosph1ph2 and sinph2ph2"
5238 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5239 & sinph1ph2(l,k),sinph1ph2(k,l)
5242 write(iout,*) "ethetai",ethetai
5246 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5247 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5248 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5249 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5250 ethetai=ethetai+sinkt(m)*aux
5251 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5252 dephii=dephii+k*sinkt(m)*(
5253 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5254 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5255 dephii1=dephii1+k*sinkt(m)*(
5256 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5257 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5259 & write (iout,*) "m",m," k",k," bbthet",
5260 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5261 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5262 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5263 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5267 & write(iout,*) "ethetai",ethetai
5271 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5272 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5273 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5274 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5275 ethetai=ethetai+sinkt(m)*aux
5276 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5277 dephii=dephii+l*sinkt(m)*(
5278 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5279 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5280 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5281 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5282 dephii1=dephii1+(k-l)*sinkt(m)*(
5283 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5284 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5285 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5286 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5288 write (iout,*) "m",m," k",k," l",l," ffthet",
5289 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5290 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5291 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5292 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5293 & " ethetai",ethetai
5294 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5295 & cosph1ph2(k,l)*sinkt(m),
5296 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5304 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5305 & i,theta(i)*rad2deg,phii*rad2deg,
5306 & phii1*rad2deg,ethetai
5308 etheta=etheta+ethetai
5309 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5310 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5311 gloc(nphi+i-2,icg)=wang*dethetai+ gloc(nphi+i-2,icg)
5317 c-----------------------------------------------------------------------------
5318 subroutine esc(escloc)
5319 C Calculate the local energy of a side chain and its derivatives in the
5320 C corresponding virtual-bond valence angles THETA and the spherical angles
5322 implicit real*8 (a-h,o-z)
5323 include 'DIMENSIONS'
5324 include 'COMMON.GEO'
5325 include 'COMMON.LOCAL'
5326 include 'COMMON.VAR'
5327 include 'COMMON.INTERACT'
5328 include 'COMMON.DERIV'
5329 include 'COMMON.CHAIN'
5330 include 'COMMON.IOUNITS'
5331 include 'COMMON.NAMES'
5332 include 'COMMON.FFIELD'
5333 include 'COMMON.CONTROL'
5334 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5335 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5336 common /sccalc/ time11,time12,time112,theti,it,nlobit
5339 c write (iout,'(a)') 'ESC'
5340 do i=loc_start,loc_end
5342 if (it.eq.ntyp1) cycle
5343 if (it.eq.10) goto 1
5344 nlobit=nlob(iabs(it))
5345 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5346 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5347 theti=theta(i+1)-pipol
5352 if (x(2).gt.pi-delta) then
5356 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5358 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5359 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5361 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5362 & ddersc0(1),dersc(1))
5363 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5364 & ddersc0(3),dersc(3))
5366 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5368 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5369 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5370 & dersc0(2),esclocbi,dersc02)
5371 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5373 call splinthet(x(2),0.5d0*delta,ss,ssd)
5378 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5380 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5381 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5383 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5385 c write (iout,*) escloci
5386 else if (x(2).lt.delta) then
5390 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5392 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5393 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5395 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5396 & ddersc0(1),dersc(1))
5397 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5398 & ddersc0(3),dersc(3))
5400 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5402 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5403 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5404 & dersc0(2),esclocbi,dersc02)
5405 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5410 call splinthet(x(2),0.5d0*delta,ss,ssd)
5412 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5414 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5415 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5417 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5418 c write (iout,*) escloci
5420 call enesc(x,escloci,dersc,ddummy,.false.)
5423 escloc=escloc+escloci
5424 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5425 & 'escloc',i,escloci
5426 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5428 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5430 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5431 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5436 C---------------------------------------------------------------------------
5437 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5438 implicit real*8 (a-h,o-z)
5439 include 'DIMENSIONS'
5440 include 'COMMON.GEO'
5441 include 'COMMON.LOCAL'
5442 include 'COMMON.IOUNITS'
5443 common /sccalc/ time11,time12,time112,theti,it,nlobit
5444 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5445 double precision contr(maxlob,-1:1)
5447 c write (iout,*) 'it=',it,' nlobit=',nlobit
5451 if (mixed) ddersc(j)=0.0d0
5455 C Because of periodicity of the dependence of the SC energy in omega we have
5456 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5457 C To avoid underflows, first compute & store the exponents.
5465 z(k)=x(k)-censc(k,j,it)
5470 Axk=Axk+gaussc(l,k,j,it)*z(l)
5476 expfac=expfac+Ax(k,j,iii)*z(k)
5484 C As in the case of ebend, we want to avoid underflows in exponentiation and
5485 C subsequent NaNs and INFs in energy calculation.
5486 C Find the largest exponent
5490 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5494 cd print *,'it=',it,' emin=',emin
5496 C Compute the contribution to SC energy and derivatives
5501 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5502 if(adexp.ne.adexp) adexp=1.0
5505 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5507 cd print *,'j=',j,' expfac=',expfac
5508 escloc_i=escloc_i+expfac
5510 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5514 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5515 & +gaussc(k,2,j,it))*expfac
5522 dersc(1)=dersc(1)/cos(theti)**2
5523 ddersc(1)=ddersc(1)/cos(theti)**2
5526 escloci=-(dlog(escloc_i)-emin)
5528 dersc(j)=dersc(j)/escloc_i
5532 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5537 C------------------------------------------------------------------------------
5538 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5539 implicit real*8 (a-h,o-z)
5540 include 'DIMENSIONS'
5541 include 'COMMON.GEO'
5542 include 'COMMON.LOCAL'
5543 include 'COMMON.IOUNITS'
5544 common /sccalc/ time11,time12,time112,theti,it,nlobit
5545 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5546 double precision contr(maxlob)
5557 z(k)=x(k)-censc(k,j,it)
5563 Axk=Axk+gaussc(l,k,j,it)*z(l)
5569 expfac=expfac+Ax(k,j)*z(k)
5574 C As in the case of ebend, we want to avoid underflows in exponentiation and
5575 C subsequent NaNs and INFs in energy calculation.
5576 C Find the largest exponent
5579 if (emin.gt.contr(j)) emin=contr(j)
5583 C Compute the contribution to SC energy and derivatives
5587 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5588 escloc_i=escloc_i+expfac
5590 dersc(k)=dersc(k)+Ax(k,j)*expfac
5592 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5593 & +gaussc(1,2,j,it))*expfac
5597 dersc(1)=dersc(1)/cos(theti)**2
5598 dersc12=dersc12/cos(theti)**2
5599 escloci=-(dlog(escloc_i)-emin)
5601 dersc(j)=dersc(j)/escloc_i
5603 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5607 c----------------------------------------------------------------------------------
5608 subroutine esc(escloc)
5609 C Calculate the local energy of a side chain and its derivatives in the
5610 C corresponding virtual-bond valence angles THETA and the spherical angles
5611 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5612 C added by Urszula Kozlowska. 07/11/2007
5614 implicit real*8 (a-h,o-z)
5615 include 'DIMENSIONS'
5616 include 'COMMON.GEO'
5617 include 'COMMON.LOCAL'
5618 include 'COMMON.VAR'
5619 include 'COMMON.SCROT'
5620 include 'COMMON.INTERACT'
5621 include 'COMMON.DERIV'
5622 include 'COMMON.CHAIN'
5623 include 'COMMON.IOUNITS'
5624 include 'COMMON.NAMES'
5625 include 'COMMON.FFIELD'
5626 include 'COMMON.CONTROL'
5627 include 'COMMON.VECTORS'
5628 double precision x_prime(3),y_prime(3),z_prime(3)
5629 & , sumene,dsc_i,dp2_i,x(65),
5630 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5631 & de_dxx,de_dyy,de_dzz,de_dt
5632 double precision s1_t,s1_6_t,s2_t,s2_6_t
5634 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5635 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5636 & dt_dCi(3),dt_dCi1(3)
5637 common /sccalc/ time11,time12,time112,theti,it,nlobit
5640 do i=loc_start,loc_end
5641 if (itype(i).eq.ntyp1) cycle
5642 costtab(i+1) =dcos(theta(i+1))
5643 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5644 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5645 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5646 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5647 cosfac=dsqrt(cosfac2)
5648 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5649 sinfac=dsqrt(sinfac2)
5651 if (it.eq.10) goto 1
5653 C Compute the axes of tghe local cartesian coordinates system; store in
5654 c x_prime, y_prime and z_prime
5661 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5662 C & dc_norm(3,i+nres)
5664 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5665 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5668 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5671 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5672 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5673 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5674 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5675 c & " xy",scalar(x_prime(1),y_prime(1)),
5676 c & " xz",scalar(x_prime(1),z_prime(1)),
5677 c & " yy",scalar(y_prime(1),y_prime(1)),
5678 c & " yz",scalar(y_prime(1),z_prime(1)),
5679 c & " zz",scalar(z_prime(1),z_prime(1))
5681 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5682 C to local coordinate system. Store in xx, yy, zz.
5688 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5689 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5690 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5697 C Compute the energy of the ith side cbain
5699 c write (2,*) "xx",xx," yy",yy," zz",zz
5702 x(j) = sc_parmin(j,it)
5705 Cc diagnostics - remove later
5707 yy1 = dsin(alph(2))*dcos(omeg(2))
5708 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5709 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5710 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5712 C," --- ", xx_w,yy_w,zz_w
5715 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5716 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5718 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5719 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5721 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5722 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5723 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5724 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5725 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5727 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5728 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5729 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5730 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5731 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5733 dsc_i = 0.743d0+x(61)
5735 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5736 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5737 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5738 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5739 s1=(1+x(63))/(0.1d0 + dscp1)
5740 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5741 s2=(1+x(65))/(0.1d0 + dscp2)
5742 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5743 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5744 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5745 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5747 c & dscp1,dscp2,sumene
5748 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5749 escloc = escloc + sumene
5750 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5755 C This section to check the numerical derivatives of the energy of ith side
5756 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5757 C #define DEBUG in the code to turn it on.
5759 write (2,*) "sumene =",sumene
5763 write (2,*) xx,yy,zz
5764 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5765 de_dxx_num=(sumenep-sumene)/aincr
5767 write (2,*) "xx+ sumene from enesc=",sumenep
5770 write (2,*) xx,yy,zz
5771 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5772 de_dyy_num=(sumenep-sumene)/aincr
5774 write (2,*) "yy+ sumene from enesc=",sumenep
5777 write (2,*) xx,yy,zz
5778 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5779 de_dzz_num=(sumenep-sumene)/aincr
5781 write (2,*) "zz+ sumene from enesc=",sumenep
5782 costsave=cost2tab(i+1)
5783 sintsave=sint2tab(i+1)
5784 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5785 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5786 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5787 de_dt_num=(sumenep-sumene)/aincr
5788 write (2,*) " t+ sumene from enesc=",sumenep
5789 cost2tab(i+1)=costsave
5790 sint2tab(i+1)=sintsave
5791 C End of diagnostics section.
5794 C Compute the gradient of esc
5796 c zz=zz*dsign(1.0,dfloat(itype(i)))
5797 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5798 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5799 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5800 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5801 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5802 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5803 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5804 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5805 pom1=(sumene3*sint2tab(i+1)+sumene1)
5806 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5807 pom2=(sumene4*cost2tab(i+1)+sumene2)
5808 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5809 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5810 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5811 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5813 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5814 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5815 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5817 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5818 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5819 & +(pom1+pom2)*pom_dx
5821 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5824 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5825 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5826 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5828 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5829 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5830 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5831 & +x(59)*zz**2 +x(60)*xx*zz
5832 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5833 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5834 & +(pom1-pom2)*pom_dy
5836 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5839 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5840 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5841 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5842 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5843 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5844 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5845 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5846 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5848 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5851 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5852 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5853 & +pom1*pom_dt1+pom2*pom_dt2
5855 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5860 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5861 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5862 cosfac2xx=cosfac2*xx
5863 sinfac2yy=sinfac2*yy
5865 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5867 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5869 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5870 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5871 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5872 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5873 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5874 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5875 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5876 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5877 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5878 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5882 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5883 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5884 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5885 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5888 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5889 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5890 dZZ_XYZ(k)=vbld_inv(i+nres)*
5891 & (z_prime(k)-zz*dC_norm(k,i+nres))
5893 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5894 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5898 dXX_Ctab(k,i)=dXX_Ci(k)
5899 dXX_C1tab(k,i)=dXX_Ci1(k)
5900 dYY_Ctab(k,i)=dYY_Ci(k)
5901 dYY_C1tab(k,i)=dYY_Ci1(k)
5902 dZZ_Ctab(k,i)=dZZ_Ci(k)
5903 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5904 dXX_XYZtab(k,i)=dXX_XYZ(k)
5905 dYY_XYZtab(k,i)=dYY_XYZ(k)
5906 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5910 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5911 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5912 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5913 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5914 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5916 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5917 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5918 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5919 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5920 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5921 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5922 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5923 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5925 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5926 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5928 C to check gradient call subroutine check_grad
5934 c------------------------------------------------------------------------------
5935 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5937 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5938 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5939 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5940 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5942 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5943 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5945 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5946 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5947 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5948 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5949 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5951 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5952 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5953 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5954 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5955 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5957 dsc_i = 0.743d0+x(61)
5959 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5960 & *(xx*cost2+yy*sint2))
5961 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5962 & *(xx*cost2-yy*sint2))
5963 s1=(1+x(63))/(0.1d0 + dscp1)
5964 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5965 s2=(1+x(65))/(0.1d0 + dscp2)
5966 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5967 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5968 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5973 c------------------------------------------------------------------------------
5974 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5976 C This procedure calculates two-body contact function g(rij) and its derivative:
5979 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5982 C where x=(rij-r0ij)/delta
5984 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5987 double precision rij,r0ij,eps0ij,fcont,fprimcont
5988 double precision x,x2,x4,delta
5992 if (x.lt.-1.0D0) then
5995 else if (x.le.1.0D0) then
5998 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5999 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6006 c------------------------------------------------------------------------------
6007 subroutine splinthet(theti,delta,ss,ssder)
6008 implicit real*8 (a-h,o-z)
6009 include 'DIMENSIONS'
6010 include 'COMMON.VAR'
6011 include 'COMMON.GEO'
6014 if (theti.gt.pipol) then
6015 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6017 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6022 c------------------------------------------------------------------------------
6023 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6025 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6026 double precision ksi,ksi2,ksi3,a1,a2,a3
6027 a1=fprim0*delta/(f1-f0)
6033 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6034 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6037 c------------------------------------------------------------------------------
6038 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6040 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6041 double precision ksi,ksi2,ksi3,a1,a2,a3
6046 a2=3*(f1x-f0x)-2*fprim0x*delta
6047 a3=fprim0x*delta-2*(f1x-f0x)
6048 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6051 C-----------------------------------------------------------------------------
6053 C-----------------------------------------------------------------------------
6054 subroutine etor(etors,edihcnstr)
6055 implicit real*8 (a-h,o-z)
6056 include 'DIMENSIONS'
6057 include 'COMMON.VAR'
6058 include 'COMMON.GEO'
6059 include 'COMMON.LOCAL'
6060 include 'COMMON.TORSION'
6061 include 'COMMON.INTERACT'
6062 include 'COMMON.DERIV'
6063 include 'COMMON.CHAIN'
6064 include 'COMMON.NAMES'
6065 include 'COMMON.IOUNITS'
6066 include 'COMMON.FFIELD'
6067 include 'COMMON.TORCNSTR'
6068 include 'COMMON.CONTROL'
6070 C Set lprn=.true. for debugging
6074 do i=iphi_start,iphi_end
6076 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6077 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6078 itori=itortyp(itype(i-2))
6079 itori1=itortyp(itype(i-1))
6082 C Proline-Proline pair is a special case...
6083 if (itori.eq.3 .and. itori1.eq.3) then
6084 if (phii.gt.-dwapi3) then
6086 fac=1.0D0/(1.0D0-cosphi)
6087 etorsi=v1(1,3,3)*fac
6088 etorsi=etorsi+etorsi
6089 etors=etors+etorsi-v1(1,3,3)
6090 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6091 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6094 v1ij=v1(j+1,itori,itori1)
6095 v2ij=v2(j+1,itori,itori1)
6098 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6099 if (energy_dec) etors_ii=etors_ii+
6100 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6101 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6105 v1ij=v1(j,itori,itori1)
6106 v2ij=v2(j,itori,itori1)
6109 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6110 if (energy_dec) etors_ii=etors_ii+
6111 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6112 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6115 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6118 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6119 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6120 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6121 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6122 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6124 ! 6/20/98 - dihedral angle constraints
6127 itori=idih_constr(i)
6130 if (difi.gt.drange(i)) then
6132 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6133 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6134 else if (difi.lt.-drange(i)) then
6136 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6137 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6139 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6140 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6142 ! write (iout,*) 'edihcnstr',edihcnstr
6145 c------------------------------------------------------------------------------
6146 subroutine etor_d(etors_d)
6150 c----------------------------------------------------------------------------
6152 subroutine etor(etors,edihcnstr)
6153 implicit real*8 (a-h,o-z)
6154 include 'DIMENSIONS'
6155 include 'COMMON.VAR'
6156 include 'COMMON.GEO'
6157 include 'COMMON.LOCAL'
6158 include 'COMMON.TORSION'
6159 include 'COMMON.INTERACT'
6160 include 'COMMON.DERIV'
6161 include 'COMMON.CHAIN'
6162 include 'COMMON.NAMES'
6163 include 'COMMON.IOUNITS'
6164 include 'COMMON.FFIELD'
6165 include 'COMMON.TORCNSTR'
6166 include 'COMMON.CONTROL'
6168 C Set lprn=.true. for debugging
6172 do i=iphi_start,iphi_end
6173 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6174 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6175 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6176 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6177 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6178 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6179 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6180 C For introducing the NH3+ and COO- group please check the etor_d for reference
6183 if (iabs(itype(i)).eq.20) then
6188 itori=itortyp(itype(i-2))
6189 itori1=itortyp(itype(i-1))
6192 C Regular cosine and sine terms
6193 do j=1,nterm(itori,itori1,iblock)
6194 v1ij=v1(j,itori,itori1,iblock)
6195 v2ij=v2(j,itori,itori1,iblock)
6198 etors=etors+v1ij*cosphi+v2ij*sinphi
6199 if (energy_dec) etors_ii=etors_ii+
6200 & v1ij*cosphi+v2ij*sinphi
6201 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6205 C E = SUM ----------------------------------- - v1
6206 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6208 cosphi=dcos(0.5d0*phii)
6209 sinphi=dsin(0.5d0*phii)
6210 do j=1,nlor(itori,itori1,iblock)
6211 vl1ij=vlor1(j,itori,itori1)
6212 vl2ij=vlor2(j,itori,itori1)
6213 vl3ij=vlor3(j,itori,itori1)
6214 pom=vl2ij*cosphi+vl3ij*sinphi
6215 pom1=1.0d0/(pom*pom+1.0d0)
6216 etors=etors+vl1ij*pom1
6217 if (energy_dec) etors_ii=etors_ii+
6220 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6222 C Subtract the constant term
6223 etors=etors-v0(itori,itori1,iblock)
6224 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6225 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6227 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6228 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6229 & (v1(j,itori,itori1,iblock),j=1,6),
6230 & (v2(j,itori,itori1,iblock),j=1,6)
6231 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6232 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6234 ! 6/20/98 - dihedral angle constraints
6236 c do i=1,ndih_constr
6237 do i=idihconstr_start,idihconstr_end
6238 itori=idih_constr(i)
6240 difi=pinorm(phii-phi0(i))
6241 if (difi.gt.drange(i)) then
6243 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6244 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6245 else if (difi.lt.-drange(i)) then
6247 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6248 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6252 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6253 cd & rad2deg*phi0(i), rad2deg*drange(i),
6254 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6256 cd write (iout,*) 'edihcnstr',edihcnstr
6259 c----------------------------------------------------------------------------
6260 subroutine etor_d(etors_d)
6261 C 6/23/01 Compute double torsional energy
6262 implicit real*8 (a-h,o-z)
6263 include 'DIMENSIONS'
6264 include 'COMMON.VAR'
6265 include 'COMMON.GEO'
6266 include 'COMMON.LOCAL'
6267 include 'COMMON.TORSION'
6268 include 'COMMON.INTERACT'
6269 include 'COMMON.DERIV'
6270 include 'COMMON.CHAIN'
6271 include 'COMMON.NAMES'
6272 include 'COMMON.IOUNITS'
6273 include 'COMMON.FFIELD'
6274 include 'COMMON.TORCNSTR'
6276 C Set lprn=.true. for debugging
6280 c write(iout,*) "a tu??"
6281 do i=iphid_start,iphid_end
6282 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6283 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6284 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6285 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6286 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6287 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6288 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6289 & (itype(i+1).eq.ntyp1)) cycle
6290 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6291 itori=itortyp(itype(i-2))
6292 itori1=itortyp(itype(i-1))
6293 itori2=itortyp(itype(i))
6299 if (iabs(itype(i+1)).eq.20) iblock=2
6300 C Iblock=2 Proline type
6301 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6302 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6303 C if (itype(i+1).eq.ntyp1) iblock=3
6304 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6305 C IS or IS NOT need for this
6306 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6307 C is (itype(i-3).eq.ntyp1) ntblock=2
6308 C ntblock is N-terminal blocking group
6310 C Regular cosine and sine terms
6311 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6312 C Example of changes for NH3+ blocking group
6313 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6314 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6315 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6316 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6317 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6318 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6319 cosphi1=dcos(j*phii)
6320 sinphi1=dsin(j*phii)
6321 cosphi2=dcos(j*phii1)
6322 sinphi2=dsin(j*phii1)
6323 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6324 & v2cij*cosphi2+v2sij*sinphi2
6325 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6326 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6328 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6330 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6331 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6332 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6333 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6334 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6335 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6336 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6337 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6338 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6339 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6340 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6341 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6342 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6343 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6346 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6347 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6352 c------------------------------------------------------------------------------
6353 subroutine eback_sc_corr(esccor)
6354 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6355 c conformational states; temporarily implemented as differences
6356 c between UNRES torsional potentials (dependent on three types of
6357 c residues) and the torsional potentials dependent on all 20 types
6358 c of residues computed from AM1 energy surfaces of terminally-blocked
6359 c amino-acid residues.
6360 implicit real*8 (a-h,o-z)
6361 include 'DIMENSIONS'
6362 include 'COMMON.VAR'
6363 include 'COMMON.GEO'
6364 include 'COMMON.LOCAL'
6365 include 'COMMON.TORSION'
6366 include 'COMMON.SCCOR'
6367 include 'COMMON.INTERACT'
6368 include 'COMMON.DERIV'
6369 include 'COMMON.CHAIN'
6370 include 'COMMON.NAMES'
6371 include 'COMMON.IOUNITS'
6372 include 'COMMON.FFIELD'
6373 include 'COMMON.CONTROL'
6375 C Set lprn=.true. for debugging
6378 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6380 do i=itau_start,itau_end
6381 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6383 isccori=isccortyp(itype(i-2))
6384 isccori1=isccortyp(itype(i-1))
6385 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6387 do intertyp=1,3 !intertyp
6388 cc Added 09 May 2012 (Adasko)
6389 cc Intertyp means interaction type of backbone mainchain correlation:
6390 c 1 = SC...Ca...Ca...Ca
6391 c 2 = Ca...Ca...Ca...SC
6392 c 3 = SC...Ca...Ca...SCi
6394 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6395 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6396 & (itype(i-1).eq.ntyp1)))
6397 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6398 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6399 & .or.(itype(i).eq.ntyp1)))
6400 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6401 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6402 & (itype(i-3).eq.ntyp1)))) cycle
6403 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6404 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6406 do j=1,nterm_sccor(isccori,isccori1)
6407 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6408 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6409 cosphi=dcos(j*tauangle(intertyp,i))
6410 sinphi=dsin(j*tauangle(intertyp,i))
6411 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6412 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6414 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6415 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6417 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6418 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6419 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6420 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6421 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6427 c----------------------------------------------------------------------------
6428 subroutine multibody(ecorr)
6429 C This subroutine calculates multi-body contributions to energy following
6430 C the idea of Skolnick et al. If side chains I and J make a contact and
6431 C at the same time side chains I+1 and J+1 make a contact, an extra
6432 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6433 implicit real*8 (a-h,o-z)
6434 include 'DIMENSIONS'
6435 include 'COMMON.IOUNITS'
6436 include 'COMMON.DERIV'
6437 include 'COMMON.INTERACT'
6438 include 'COMMON.CONTACTS'
6439 double precision gx(3),gx1(3)
6442 C Set lprn=.true. for debugging
6446 write (iout,'(a)') 'Contact function values:'
6448 write (iout,'(i2,20(1x,i2,f10.5))')
6449 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6464 num_conti=num_cont(i)
6465 num_conti1=num_cont(i1)
6470 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6471 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6472 cd & ' ishift=',ishift
6473 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6474 C The system gains extra energy.
6475 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6476 endif ! j1==j+-ishift
6485 c------------------------------------------------------------------------------
6486 double precision function esccorr(i,j,k,l,jj,kk)
6487 implicit real*8 (a-h,o-z)
6488 include 'DIMENSIONS'
6489 include 'COMMON.IOUNITS'
6490 include 'COMMON.DERIV'
6491 include 'COMMON.INTERACT'
6492 include 'COMMON.CONTACTS'
6493 double precision gx(3),gx1(3)
6498 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6499 C Calculate the multi-body contribution to energy.
6500 C Calculate multi-body contributions to the gradient.
6501 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6502 cd & k,l,(gacont(m,kk,k),m=1,3)
6504 gx(m) =ekl*gacont(m,jj,i)
6505 gx1(m)=eij*gacont(m,kk,k)
6506 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6507 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6508 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6509 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6513 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6518 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6524 c------------------------------------------------------------------------------
6525 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6526 C This subroutine calculates multi-body contributions to hydrogen-bonding
6527 implicit real*8 (a-h,o-z)
6528 include 'DIMENSIONS'
6529 include 'COMMON.IOUNITS'
6532 parameter (max_cont=maxconts)
6533 parameter (max_dim=26)
6534 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6535 double precision zapas(max_dim,maxconts,max_fg_procs),
6536 & zapas_recv(max_dim,maxconts,max_fg_procs)
6537 common /przechowalnia/ zapas
6538 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6539 & status_array(MPI_STATUS_SIZE,maxconts*2)
6541 include 'COMMON.SETUP'
6542 include 'COMMON.FFIELD'
6543 include 'COMMON.DERIV'
6544 include 'COMMON.INTERACT'
6545 include 'COMMON.CONTACTS'
6546 include 'COMMON.CONTROL'
6547 include 'COMMON.LOCAL'
6548 double precision gx(3),gx1(3),time00
6551 C Set lprn=.true. for debugging
6556 if (nfgtasks.le.1) goto 30
6558 write (iout,'(a)') 'Contact function values before RECEIVE:'
6560 write (iout,'(2i3,50(1x,i2,f5.2))')
6561 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6562 & j=1,num_cont_hb(i))
6566 do i=1,ntask_cont_from
6569 do i=1,ntask_cont_to
6572 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6574 C Make the list of contacts to send to send to other procesors
6575 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6577 do i=iturn3_start,iturn3_end
6578 c write (iout,*) "make contact list turn3",i," num_cont",
6580 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6582 do i=iturn4_start,iturn4_end
6583 c write (iout,*) "make contact list turn4",i," num_cont",
6585 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6589 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6591 do j=1,num_cont_hb(i)
6594 iproc=iint_sent_local(k,jjc,ii)
6595 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6596 if (iproc.gt.0) then
6597 ncont_sent(iproc)=ncont_sent(iproc)+1
6598 nn=ncont_sent(iproc)
6600 zapas(2,nn,iproc)=jjc
6601 zapas(3,nn,iproc)=facont_hb(j,i)
6602 zapas(4,nn,iproc)=ees0p(j,i)
6603 zapas(5,nn,iproc)=ees0m(j,i)
6604 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6605 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6606 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6607 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6608 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6609 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6610 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6611 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6612 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6613 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6614 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6615 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6616 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6617 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6618 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6619 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6620 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6621 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6622 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6623 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6624 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6631 & "Numbers of contacts to be sent to other processors",
6632 & (ncont_sent(i),i=1,ntask_cont_to)
6633 write (iout,*) "Contacts sent"
6634 do ii=1,ntask_cont_to
6636 iproc=itask_cont_to(ii)
6637 write (iout,*) nn," contacts to processor",iproc,
6638 & " of CONT_TO_COMM group"
6640 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6648 CorrelID1=nfgtasks+fg_rank+1
6650 C Receive the numbers of needed contacts from other processors
6651 do ii=1,ntask_cont_from
6652 iproc=itask_cont_from(ii)
6654 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6655 & FG_COMM,req(ireq),IERR)
6657 c write (iout,*) "IRECV ended"
6659 C Send the number of contacts needed by other processors
6660 do ii=1,ntask_cont_to
6661 iproc=itask_cont_to(ii)
6663 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6664 & FG_COMM,req(ireq),IERR)
6666 c write (iout,*) "ISEND ended"
6667 c write (iout,*) "number of requests (nn)",ireq
6670 & call MPI_Waitall(ireq,req,status_array,ierr)
6672 c & "Numbers of contacts to be received from other processors",
6673 c & (ncont_recv(i),i=1,ntask_cont_from)
6677 do ii=1,ntask_cont_from
6678 iproc=itask_cont_from(ii)
6680 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6681 c & " of CONT_TO_COMM group"
6685 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6686 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6687 c write (iout,*) "ireq,req",ireq,req(ireq)
6690 C Send the contacts to processors that need them
6691 do ii=1,ntask_cont_to
6692 iproc=itask_cont_to(ii)
6694 c write (iout,*) nn," contacts to processor",iproc,
6695 c & " of CONT_TO_COMM group"
6698 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6699 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6700 c write (iout,*) "ireq,req",ireq,req(ireq)
6702 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6706 c write (iout,*) "number of requests (contacts)",ireq
6707 c write (iout,*) "req",(req(i),i=1,4)
6710 & call MPI_Waitall(ireq,req,status_array,ierr)
6711 do iii=1,ntask_cont_from
6712 iproc=itask_cont_from(iii)
6715 write (iout,*) "Received",nn," contacts from processor",iproc,
6716 & " of CONT_FROM_COMM group"
6719 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6724 ii=zapas_recv(1,i,iii)
6725 c Flag the received contacts to prevent double-counting
6726 jj=-zapas_recv(2,i,iii)
6727 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6729 nnn=num_cont_hb(ii)+1
6732 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6733 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6734 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6735 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6736 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6737 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6738 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6739 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6740 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6741 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6742 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6743 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6744 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6745 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6746 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6747 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6748 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6749 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6750 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6751 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6752 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6753 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6754 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6755 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6760 write (iout,'(a)') 'Contact function values after receive:'
6762 write (iout,'(2i3,50(1x,i3,f5.2))')
6763 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6764 & j=1,num_cont_hb(i))
6771 write (iout,'(a)') 'Contact function values:'
6773 write (iout,'(2i3,50(1x,i3,f5.2))')
6774 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6775 & j=1,num_cont_hb(i))
6779 C Remove the loop below after debugging !!!
6786 C Calculate the local-electrostatic correlation terms
6787 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6789 num_conti=num_cont_hb(i)
6790 num_conti1=num_cont_hb(i+1)
6797 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6798 c & ' jj=',jj,' kk=',kk
6799 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6800 & .or. j.lt.0 .and. j1.gt.0) .and.
6801 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6802 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6803 C The system gains extra energy.
6804 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6805 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6806 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6808 else if (j1.eq.j) then
6809 C Contacts I-J and I-(J+1) occur simultaneously.
6810 C The system loses extra energy.
6811 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6816 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6817 c & ' jj=',jj,' kk=',kk
6819 C Contacts I-J and (I+1)-J occur simultaneously.
6820 C The system loses extra energy.
6821 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6828 c------------------------------------------------------------------------------
6829 subroutine add_hb_contact(ii,jj,itask)
6830 implicit real*8 (a-h,o-z)
6831 include "DIMENSIONS"
6832 include "COMMON.IOUNITS"
6835 parameter (max_cont=maxconts)
6836 parameter (max_dim=26)
6837 include "COMMON.CONTACTS"
6838 double precision zapas(max_dim,maxconts,max_fg_procs),
6839 & zapas_recv(max_dim,maxconts,max_fg_procs)
6840 common /przechowalnia/ zapas
6841 integer i,j,ii,jj,iproc,itask(4),nn
6842 c write (iout,*) "itask",itask
6845 if (iproc.gt.0) then
6846 do j=1,num_cont_hb(ii)
6848 c write (iout,*) "i",ii," j",jj," jjc",jjc
6850 ncont_sent(iproc)=ncont_sent(iproc)+1
6851 nn=ncont_sent(iproc)
6852 zapas(1,nn,iproc)=ii
6853 zapas(2,nn,iproc)=jjc
6854 zapas(3,nn,iproc)=facont_hb(j,ii)
6855 zapas(4,nn,iproc)=ees0p(j,ii)
6856 zapas(5,nn,iproc)=ees0m(j,ii)
6857 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6858 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6859 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6860 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6861 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6862 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6863 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6864 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6865 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6866 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6867 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6868 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6869 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6870 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6871 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6872 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6873 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6874 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6875 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6876 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6877 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6885 c------------------------------------------------------------------------------
6886 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6888 C This subroutine calculates multi-body contributions to hydrogen-bonding
6889 implicit real*8 (a-h,o-z)
6890 include 'DIMENSIONS'
6891 include 'COMMON.IOUNITS'
6894 parameter (max_cont=maxconts)
6895 parameter (max_dim=70)
6896 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6897 double precision zapas(max_dim,maxconts,max_fg_procs),
6898 & zapas_recv(max_dim,maxconts,max_fg_procs)
6899 common /przechowalnia/ zapas
6900 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6901 & status_array(MPI_STATUS_SIZE,maxconts*2)
6903 include 'COMMON.SETUP'
6904 include 'COMMON.FFIELD'
6905 include 'COMMON.DERIV'
6906 include 'COMMON.LOCAL'
6907 include 'COMMON.INTERACT'
6908 include 'COMMON.CONTACTS'
6909 include 'COMMON.CHAIN'
6910 include 'COMMON.CONTROL'
6911 double precision gx(3),gx1(3)
6912 integer num_cont_hb_old(maxres)
6914 double precision eello4,eello5,eelo6,eello_turn6
6915 external eello4,eello5,eello6,eello_turn6
6916 C Set lprn=.true. for debugging
6921 num_cont_hb_old(i)=num_cont_hb(i)
6925 if (nfgtasks.le.1) goto 30
6927 write (iout,'(a)') 'Contact function values before RECEIVE:'
6929 write (iout,'(2i3,50(1x,i2,f5.2))')
6930 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6931 & j=1,num_cont_hb(i))
6935 do i=1,ntask_cont_from
6938 do i=1,ntask_cont_to
6941 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6943 C Make the list of contacts to send to send to other procesors
6944 do i=iturn3_start,iturn3_end
6945 c write (iout,*) "make contact list turn3",i," num_cont",
6947 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6949 do i=iturn4_start,iturn4_end
6950 c write (iout,*) "make contact list turn4",i," num_cont",
6952 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6956 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6958 do j=1,num_cont_hb(i)
6961 iproc=iint_sent_local(k,jjc,ii)
6962 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6963 if (iproc.ne.0) then
6964 ncont_sent(iproc)=ncont_sent(iproc)+1
6965 nn=ncont_sent(iproc)
6967 zapas(2,nn,iproc)=jjc
6968 zapas(3,nn,iproc)=d_cont(j,i)
6972 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6977 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6985 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6996 & "Numbers of contacts to be sent to other processors",
6997 & (ncont_sent(i),i=1,ntask_cont_to)
6998 write (iout,*) "Contacts sent"
6999 do ii=1,ntask_cont_to
7001 iproc=itask_cont_to(ii)
7002 write (iout,*) nn," contacts to processor",iproc,
7003 & " of CONT_TO_COMM group"
7005 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7013 CorrelID1=nfgtasks+fg_rank+1
7015 C Receive the numbers of needed contacts from other processors
7016 do ii=1,ntask_cont_from
7017 iproc=itask_cont_from(ii)
7019 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7020 & FG_COMM,req(ireq),IERR)
7022 c write (iout,*) "IRECV ended"
7024 C Send the number of contacts needed by other processors
7025 do ii=1,ntask_cont_to
7026 iproc=itask_cont_to(ii)
7028 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7029 & FG_COMM,req(ireq),IERR)
7031 c write (iout,*) "ISEND ended"
7032 c write (iout,*) "number of requests (nn)",ireq
7035 & call MPI_Waitall(ireq,req,status_array,ierr)
7037 c & "Numbers of contacts to be received from other processors",
7038 c & (ncont_recv(i),i=1,ntask_cont_from)
7042 do ii=1,ntask_cont_from
7043 iproc=itask_cont_from(ii)
7045 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7046 c & " of CONT_TO_COMM group"
7050 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7051 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7052 c write (iout,*) "ireq,req",ireq,req(ireq)
7055 C Send the contacts to processors that need them
7056 do ii=1,ntask_cont_to
7057 iproc=itask_cont_to(ii)
7059 c write (iout,*) nn," contacts to processor",iproc,
7060 c & " of CONT_TO_COMM group"
7063 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7064 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7065 c write (iout,*) "ireq,req",ireq,req(ireq)
7067 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7071 c write (iout,*) "number of requests (contacts)",ireq
7072 c write (iout,*) "req",(req(i),i=1,4)
7075 & call MPI_Waitall(ireq,req,status_array,ierr)
7076 do iii=1,ntask_cont_from
7077 iproc=itask_cont_from(iii)
7080 write (iout,*) "Received",nn," contacts from processor",iproc,
7081 & " of CONT_FROM_COMM group"
7084 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7089 ii=zapas_recv(1,i,iii)
7090 c Flag the received contacts to prevent double-counting
7091 jj=-zapas_recv(2,i,iii)
7092 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7094 nnn=num_cont_hb(ii)+1
7097 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7101 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7106 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7114 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7123 write (iout,'(a)') 'Contact function values after receive:'
7125 write (iout,'(2i3,50(1x,i3,5f6.3))')
7126 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7127 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7134 write (iout,'(a)') 'Contact function values:'
7136 write (iout,'(2i3,50(1x,i2,5f6.3))')
7137 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7138 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7144 C Remove the loop below after debugging !!!
7151 C Calculate the dipole-dipole interaction energies
7152 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7153 do i=iatel_s,iatel_e+1
7154 num_conti=num_cont_hb(i)
7163 C Calculate the local-electrostatic correlation terms
7164 c write (iout,*) "gradcorr5 in eello5 before loop"
7166 c write (iout,'(i5,3f10.5)')
7167 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7169 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7170 c write (iout,*) "corr loop i",i
7172 num_conti=num_cont_hb(i)
7173 num_conti1=num_cont_hb(i+1)
7180 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7181 c & ' jj=',jj,' kk=',kk
7182 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7183 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7184 & .or. j.lt.0 .and. j1.gt.0) .and.
7185 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7186 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7187 C The system gains extra energy.
7189 sqd1=dsqrt(d_cont(jj,i))
7190 sqd2=dsqrt(d_cont(kk,i1))
7191 sred_geom = sqd1*sqd2
7192 IF (sred_geom.lt.cutoff_corr) THEN
7193 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7195 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7196 cd & ' jj=',jj,' kk=',kk
7197 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7198 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7200 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7201 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7204 cd write (iout,*) 'sred_geom=',sred_geom,
7205 cd & ' ekont=',ekont,' fprim=',fprimcont,
7206 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7207 cd write (iout,*) "g_contij",g_contij
7208 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7209 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7210 call calc_eello(i,jp,i+1,jp1,jj,kk)
7211 if (wcorr4.gt.0.0d0)
7212 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7213 if (energy_dec.and.wcorr4.gt.0.0d0)
7214 1 write (iout,'(a6,4i5,0pf7.3)')
7215 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7216 c write (iout,*) "gradcorr5 before eello5"
7218 c write (iout,'(i5,3f10.5)')
7219 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7221 if (wcorr5.gt.0.0d0)
7222 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7223 c write (iout,*) "gradcorr5 after eello5"
7225 c write (iout,'(i5,3f10.5)')
7226 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7228 if (energy_dec.and.wcorr5.gt.0.0d0)
7229 1 write (iout,'(a6,4i5,0pf7.3)')
7230 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7231 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7232 cd write(2,*)'ijkl',i,jp,i+1,jp1
7233 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7234 & .or. wturn6.eq.0.0d0))then
7235 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7236 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7237 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7238 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7239 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7240 cd & 'ecorr6=',ecorr6
7241 cd write (iout,'(4e15.5)') sred_geom,
7242 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7243 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7244 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7245 else if (wturn6.gt.0.0d0
7246 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7247 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7248 eturn6=eturn6+eello_turn6(i,jj,kk)
7249 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7250 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7251 cd write (2,*) 'multibody_eello:eturn6',eturn6
7260 num_cont_hb(i)=num_cont_hb_old(i)
7262 c write (iout,*) "gradcorr5 in eello5"
7264 c write (iout,'(i5,3f10.5)')
7265 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7269 c------------------------------------------------------------------------------
7270 subroutine add_hb_contact_eello(ii,jj,itask)
7271 implicit real*8 (a-h,o-z)
7272 include "DIMENSIONS"
7273 include "COMMON.IOUNITS"
7276 parameter (max_cont=maxconts)
7277 parameter (max_dim=70)
7278 include "COMMON.CONTACTS"
7279 double precision zapas(max_dim,maxconts,max_fg_procs),
7280 & zapas_recv(max_dim,maxconts,max_fg_procs)
7281 common /przechowalnia/ zapas
7282 integer i,j,ii,jj,iproc,itask(4),nn
7283 c write (iout,*) "itask",itask
7286 if (iproc.gt.0) then
7287 do j=1,num_cont_hb(ii)
7289 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7291 ncont_sent(iproc)=ncont_sent(iproc)+1
7292 nn=ncont_sent(iproc)
7293 zapas(1,nn,iproc)=ii
7294 zapas(2,nn,iproc)=jjc
7295 zapas(3,nn,iproc)=d_cont(j,ii)
7299 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7304 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7312 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7324 c------------------------------------------------------------------------------
7325 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7326 implicit real*8 (a-h,o-z)
7327 include 'DIMENSIONS'
7328 include 'COMMON.IOUNITS'
7329 include 'COMMON.DERIV'
7330 include 'COMMON.INTERACT'
7331 include 'COMMON.CONTACTS'
7332 double precision gx(3),gx1(3)
7342 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7343 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7344 C Following 4 lines for diagnostics.
7349 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7350 c & 'Contacts ',i,j,
7351 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7352 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7354 C Calculate the multi-body contribution to energy.
7355 c ecorr=ecorr+ekont*ees
7356 C Calculate multi-body contributions to the gradient.
7357 coeffpees0pij=coeffp*ees0pij
7358 coeffmees0mij=coeffm*ees0mij
7359 coeffpees0pkl=coeffp*ees0pkl
7360 coeffmees0mkl=coeffm*ees0mkl
7362 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7363 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7364 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7365 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7366 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7367 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7368 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7369 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7370 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7371 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7372 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7373 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7374 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7375 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7376 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7377 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7378 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7379 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7380 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7381 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7382 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7383 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7384 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7385 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7386 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7391 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7392 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7393 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7394 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7399 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7400 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7401 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7402 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7405 c write (iout,*) "ehbcorr",ekont*ees
7410 C---------------------------------------------------------------------------
7411 subroutine dipole(i,j,jj)
7412 implicit real*8 (a-h,o-z)
7413 include 'DIMENSIONS'
7414 include 'COMMON.IOUNITS'
7415 include 'COMMON.CHAIN'
7416 include 'COMMON.FFIELD'
7417 include 'COMMON.DERIV'
7418 include 'COMMON.INTERACT'
7419 include 'COMMON.CONTACTS'
7420 include 'COMMON.TORSION'
7421 include 'COMMON.VAR'
7422 include 'COMMON.GEO'
7423 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7425 iti1 = itortyp(itype(i+1))
7426 if (j.lt.nres-1) then
7427 itj1 = itortyp(itype(j+1))
7432 dipi(iii,1)=Ub2(iii,i)
7433 dipderi(iii)=Ub2der(iii,i)
7434 dipi(iii,2)=b1(iii,iti1)
7435 dipj(iii,1)=Ub2(iii,j)
7436 dipderj(iii)=Ub2der(iii,j)
7437 dipj(iii,2)=b1(iii,itj1)
7441 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7444 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7451 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7455 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7460 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7461 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7463 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7465 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7467 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7472 C---------------------------------------------------------------------------
7473 subroutine calc_eello(i,j,k,l,jj,kk)
7475 C This subroutine computes matrices and vectors needed to calculate
7476 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7478 implicit real*8 (a-h,o-z)
7479 include 'DIMENSIONS'
7480 include 'COMMON.IOUNITS'
7481 include 'COMMON.CHAIN'
7482 include 'COMMON.DERIV'
7483 include 'COMMON.INTERACT'
7484 include 'COMMON.CONTACTS'
7485 include 'COMMON.TORSION'
7486 include 'COMMON.VAR'
7487 include 'COMMON.GEO'
7488 include 'COMMON.FFIELD'
7489 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7490 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7493 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7494 cd & ' jj=',jj,' kk=',kk
7495 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7496 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7497 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7500 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7501 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7504 call transpose2(aa1(1,1),aa1t(1,1))
7505 call transpose2(aa2(1,1),aa2t(1,1))
7508 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7509 & aa1tder(1,1,lll,kkk))
7510 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7511 & aa2tder(1,1,lll,kkk))
7515 C parallel orientation of the two CA-CA-CA frames.
7517 iti=itortyp(itype(i))
7521 itk1=itortyp(itype(k+1))
7522 itj=itortyp(itype(j))
7523 if (l.lt.nres-1) then
7524 itl1=itortyp(itype(l+1))
7528 C A1 kernel(j+1) A2T
7530 cd write (iout,'(3f10.5,5x,3f10.5)')
7531 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7533 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7534 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7535 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7536 C Following matrices are needed only for 6-th order cumulants
7537 IF (wcorr6.gt.0.0d0) THEN
7538 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7539 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7540 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7541 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7542 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7543 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7544 & ADtEAderx(1,1,1,1,1,1))
7546 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7547 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7548 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7549 & ADtEA1derx(1,1,1,1,1,1))
7551 C End 6-th order cumulants
7554 cd write (2,*) 'In calc_eello6'
7556 cd write (2,*) 'iii=',iii
7558 cd write (2,*) 'kkk=',kkk
7560 cd write (2,'(3(2f10.5),5x)')
7561 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7566 call transpose2(EUgder(1,1,k),auxmat(1,1))
7567 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7568 call transpose2(EUg(1,1,k),auxmat(1,1))
7569 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7570 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7574 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7575 & EAEAderx(1,1,lll,kkk,iii,1))
7579 C A1T kernel(i+1) A2
7580 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7581 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7582 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7583 C Following matrices are needed only for 6-th order cumulants
7584 IF (wcorr6.gt.0.0d0) THEN
7585 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7586 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7587 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7588 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7589 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7590 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7591 & ADtEAderx(1,1,1,1,1,2))
7592 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7593 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7594 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7595 & ADtEA1derx(1,1,1,1,1,2))
7597 C End 6-th order cumulants
7598 call transpose2(EUgder(1,1,l),auxmat(1,1))
7599 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7600 call transpose2(EUg(1,1,l),auxmat(1,1))
7601 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7602 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7606 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7607 & EAEAderx(1,1,lll,kkk,iii,2))
7612 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7613 C They are needed only when the fifth- or the sixth-order cumulants are
7615 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7616 call transpose2(AEA(1,1,1),auxmat(1,1))
7617 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7618 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7619 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7620 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7621 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7622 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7623 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7624 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7625 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7626 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7627 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7628 call transpose2(AEA(1,1,2),auxmat(1,1))
7629 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7630 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7631 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7632 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7633 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7634 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7635 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7636 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7637 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7638 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7639 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7640 C Calculate the Cartesian derivatives of the vectors.
7644 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7645 call matvec2(auxmat(1,1),b1(1,iti),
7646 & AEAb1derx(1,lll,kkk,iii,1,1))
7647 call matvec2(auxmat(1,1),Ub2(1,i),
7648 & AEAb2derx(1,lll,kkk,iii,1,1))
7649 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7650 & AEAb1derx(1,lll,kkk,iii,2,1))
7651 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7652 & AEAb2derx(1,lll,kkk,iii,2,1))
7653 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7654 call matvec2(auxmat(1,1),b1(1,itj),
7655 & AEAb1derx(1,lll,kkk,iii,1,2))
7656 call matvec2(auxmat(1,1),Ub2(1,j),
7657 & AEAb2derx(1,lll,kkk,iii,1,2))
7658 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7659 & AEAb1derx(1,lll,kkk,iii,2,2))
7660 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7661 & AEAb2derx(1,lll,kkk,iii,2,2))
7668 C Antiparallel orientation of the two CA-CA-CA frames.
7670 iti=itortyp(itype(i))
7674 itk1=itortyp(itype(k+1))
7675 itl=itortyp(itype(l))
7676 itj=itortyp(itype(j))
7677 if (j.lt.nres-1) then
7678 itj1=itortyp(itype(j+1))
7682 C A2 kernel(j-1)T A1T
7683 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7684 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7685 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7686 C Following matrices are needed only for 6-th order cumulants
7687 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7688 & j.eq.i+4 .and. l.eq.i+3)) THEN
7689 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7690 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7691 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7692 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7693 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7694 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7695 & ADtEAderx(1,1,1,1,1,1))
7696 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7697 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7698 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7699 & ADtEA1derx(1,1,1,1,1,1))
7701 C End 6-th order cumulants
7702 call transpose2(EUgder(1,1,k),auxmat(1,1))
7703 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7704 call transpose2(EUg(1,1,k),auxmat(1,1))
7705 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7706 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7710 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7711 & EAEAderx(1,1,lll,kkk,iii,1))
7715 C A2T kernel(i+1)T A1
7716 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7717 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7718 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7719 C Following matrices are needed only for 6-th order cumulants
7720 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7721 & j.eq.i+4 .and. l.eq.i+3)) THEN
7722 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7723 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7724 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7725 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7726 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7727 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7728 & ADtEAderx(1,1,1,1,1,2))
7729 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7730 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7731 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7732 & ADtEA1derx(1,1,1,1,1,2))
7734 C End 6-th order cumulants
7735 call transpose2(EUgder(1,1,j),auxmat(1,1))
7736 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7737 call transpose2(EUg(1,1,j),auxmat(1,1))
7738 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7739 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7743 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7744 & EAEAderx(1,1,lll,kkk,iii,2))
7749 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7750 C They are needed only when the fifth- or the sixth-order cumulants are
7752 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7753 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7754 call transpose2(AEA(1,1,1),auxmat(1,1))
7755 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7756 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7757 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7758 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7759 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7760 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7761 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7762 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7763 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7764 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7765 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7766 call transpose2(AEA(1,1,2),auxmat(1,1))
7767 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7768 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7769 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7770 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7771 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7772 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7773 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7774 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7775 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7776 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7777 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7778 C Calculate the Cartesian derivatives of the vectors.
7782 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7783 call matvec2(auxmat(1,1),b1(1,iti),
7784 & AEAb1derx(1,lll,kkk,iii,1,1))
7785 call matvec2(auxmat(1,1),Ub2(1,i),
7786 & AEAb2derx(1,lll,kkk,iii,1,1))
7787 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7788 & AEAb1derx(1,lll,kkk,iii,2,1))
7789 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7790 & AEAb2derx(1,lll,kkk,iii,2,1))
7791 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7792 call matvec2(auxmat(1,1),b1(1,itl),
7793 & AEAb1derx(1,lll,kkk,iii,1,2))
7794 call matvec2(auxmat(1,1),Ub2(1,l),
7795 & AEAb2derx(1,lll,kkk,iii,1,2))
7796 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7797 & AEAb1derx(1,lll,kkk,iii,2,2))
7798 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7799 & AEAb2derx(1,lll,kkk,iii,2,2))
7808 C---------------------------------------------------------------------------
7809 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7810 & KK,KKderg,AKA,AKAderg,AKAderx)
7814 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7815 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7816 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7821 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7823 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7826 cd if (lprn) write (2,*) 'In kernel'
7828 cd if (lprn) write (2,*) 'kkk=',kkk
7830 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7831 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7833 cd write (2,*) 'lll=',lll
7834 cd write (2,*) 'iii=1'
7836 cd write (2,'(3(2f10.5),5x)')
7837 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7840 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7841 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7843 cd write (2,*) 'lll=',lll
7844 cd write (2,*) 'iii=2'
7846 cd write (2,'(3(2f10.5),5x)')
7847 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7854 C---------------------------------------------------------------------------
7855 double precision function eello4(i,j,k,l,jj,kk)
7856 implicit real*8 (a-h,o-z)
7857 include 'DIMENSIONS'
7858 include 'COMMON.IOUNITS'
7859 include 'COMMON.CHAIN'
7860 include 'COMMON.DERIV'
7861 include 'COMMON.INTERACT'
7862 include 'COMMON.CONTACTS'
7863 include 'COMMON.TORSION'
7864 include 'COMMON.VAR'
7865 include 'COMMON.GEO'
7866 double precision pizda(2,2),ggg1(3),ggg2(3)
7867 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7871 cd print *,'eello4:',i,j,k,l,jj,kk
7872 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7873 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7874 cold eij=facont_hb(jj,i)
7875 cold ekl=facont_hb(kk,k)
7877 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7878 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7879 gcorr_loc(k-1)=gcorr_loc(k-1)
7880 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7882 gcorr_loc(l-1)=gcorr_loc(l-1)
7883 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7885 gcorr_loc(j-1)=gcorr_loc(j-1)
7886 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7891 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7892 & -EAEAderx(2,2,lll,kkk,iii,1)
7893 cd derx(lll,kkk,iii)=0.0d0
7897 cd gcorr_loc(l-1)=0.0d0
7898 cd gcorr_loc(j-1)=0.0d0
7899 cd gcorr_loc(k-1)=0.0d0
7901 cd write (iout,*)'Contacts have occurred for peptide groups',
7902 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7903 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7904 if (j.lt.nres-1) then
7911 if (l.lt.nres-1) then
7919 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7920 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7921 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7922 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7923 cgrad ghalf=0.5d0*ggg1(ll)
7924 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7925 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7926 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7927 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7928 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7929 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7930 cgrad ghalf=0.5d0*ggg2(ll)
7931 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7932 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7933 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7934 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7935 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7936 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7940 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7945 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7950 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7955 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7959 cd write (2,*) iii,gcorr_loc(iii)
7962 cd write (2,*) 'ekont',ekont
7963 cd write (iout,*) 'eello4',ekont*eel4
7966 C---------------------------------------------------------------------------
7967 double precision function eello5(i,j,k,l,jj,kk)
7968 implicit real*8 (a-h,o-z)
7969 include 'DIMENSIONS'
7970 include 'COMMON.IOUNITS'
7971 include 'COMMON.CHAIN'
7972 include 'COMMON.DERIV'
7973 include 'COMMON.INTERACT'
7974 include 'COMMON.CONTACTS'
7975 include 'COMMON.TORSION'
7976 include 'COMMON.VAR'
7977 include 'COMMON.GEO'
7978 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7979 double precision ggg1(3),ggg2(3)
7980 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7985 C /l\ / \ \ / \ / \ / C
7986 C / \ / \ \ / \ / \ / C
7987 C j| o |l1 | o | o| o | | o |o C
7988 C \ |/k\| |/ \| / |/ \| |/ \| C
7989 C \i/ \ / \ / / \ / \ C
7991 C (I) (II) (III) (IV) C
7993 C eello5_1 eello5_2 eello5_3 eello5_4 C
7995 C Antiparallel chains C
7998 C /j\ / \ \ / \ / \ / C
7999 C / \ / \ \ / \ / \ / C
8000 C j1| o |l | o | o| o | | o |o C
8001 C \ |/k\| |/ \| / |/ \| |/ \| C
8002 C \i/ \ / \ / / \ / \ C
8004 C (I) (II) (III) (IV) C
8006 C eello5_1 eello5_2 eello5_3 eello5_4 C
8008 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8010 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8011 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8016 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8018 itk=itortyp(itype(k))
8019 itl=itortyp(itype(l))
8020 itj=itortyp(itype(j))
8025 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8026 cd & eel5_3_num,eel5_4_num)
8030 derx(lll,kkk,iii)=0.0d0
8034 cd eij=facont_hb(jj,i)
8035 cd ekl=facont_hb(kk,k)
8037 cd write (iout,*)'Contacts have occurred for peptide groups',
8038 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8040 C Contribution from the graph I.
8041 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8042 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8043 call transpose2(EUg(1,1,k),auxmat(1,1))
8044 call matmat2(AEA(1,1,1),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_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8048 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8049 C Explicit gradient in virtual-dihedral angles.
8050 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8051 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8052 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8053 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8054 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8055 vv(1)=pizda(1,1)-pizda(2,2)
8056 vv(2)=pizda(1,2)+pizda(2,1)
8057 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8058 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8059 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8060 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8061 vv(1)=pizda(1,1)-pizda(2,2)
8062 vv(2)=pizda(1,2)+pizda(2,1)
8064 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8065 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8066 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8068 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8069 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8070 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8072 C Cartesian gradient
8076 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8078 vv(1)=pizda(1,1)-pizda(2,2)
8079 vv(2)=pizda(1,2)+pizda(2,1)
8080 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8081 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8082 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8088 C Contribution from graph II
8089 call transpose2(EE(1,1,itk),auxmat(1,1))
8090 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8091 vv(1)=pizda(1,1)+pizda(2,2)
8092 vv(2)=pizda(2,1)-pizda(1,2)
8093 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
8094 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8095 C Explicit gradient in virtual-dihedral angles.
8096 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8097 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8098 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8099 vv(1)=pizda(1,1)+pizda(2,2)
8100 vv(2)=pizda(2,1)-pizda(1,2)
8102 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8103 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8104 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8106 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8107 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8108 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8110 C Cartesian gradient
8114 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8116 vv(1)=pizda(1,1)+pizda(2,2)
8117 vv(2)=pizda(2,1)-pizda(1,2)
8118 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8119 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
8120 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8128 C Parallel orientation
8129 C Contribution from graph III
8130 call transpose2(EUg(1,1,l),auxmat(1,1))
8131 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8132 vv(1)=pizda(1,1)-pizda(2,2)
8133 vv(2)=pizda(1,2)+pizda(2,1)
8134 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8135 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8136 C Explicit gradient in virtual-dihedral angles.
8137 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8138 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8139 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8140 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8141 vv(1)=pizda(1,1)-pizda(2,2)
8142 vv(2)=pizda(1,2)+pizda(2,1)
8143 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8144 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8145 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8146 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8147 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8148 vv(1)=pizda(1,1)-pizda(2,2)
8149 vv(2)=pizda(1,2)+pizda(2,1)
8150 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8151 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8152 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8153 C Cartesian gradient
8157 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8159 vv(1)=pizda(1,1)-pizda(2,2)
8160 vv(2)=pizda(1,2)+pizda(2,1)
8161 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8162 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8163 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8168 C Contribution from graph IV
8170 call transpose2(EE(1,1,itl),auxmat(1,1))
8171 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8172 vv(1)=pizda(1,1)+pizda(2,2)
8173 vv(2)=pizda(2,1)-pizda(1,2)
8174 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
8175 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8176 C Explicit gradient in virtual-dihedral angles.
8177 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8178 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8179 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8180 vv(1)=pizda(1,1)+pizda(2,2)
8181 vv(2)=pizda(2,1)-pizda(1,2)
8182 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8183 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
8184 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8185 C Cartesian gradient
8189 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8191 vv(1)=pizda(1,1)+pizda(2,2)
8192 vv(2)=pizda(2,1)-pizda(1,2)
8193 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8194 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
8195 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8200 C Antiparallel orientation
8201 C Contribution from graph III
8203 call transpose2(EUg(1,1,j),auxmat(1,1))
8204 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8205 vv(1)=pizda(1,1)-pizda(2,2)
8206 vv(2)=pizda(1,2)+pizda(2,1)
8207 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8208 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8209 C Explicit gradient in virtual-dihedral angles.
8210 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8211 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8212 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8213 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8214 vv(1)=pizda(1,1)-pizda(2,2)
8215 vv(2)=pizda(1,2)+pizda(2,1)
8216 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8217 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8218 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8219 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8220 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8221 vv(1)=pizda(1,1)-pizda(2,2)
8222 vv(2)=pizda(1,2)+pizda(2,1)
8223 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8224 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8225 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8226 C Cartesian gradient
8230 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8232 vv(1)=pizda(1,1)-pizda(2,2)
8233 vv(2)=pizda(1,2)+pizda(2,1)
8234 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8235 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8236 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8241 C Contribution from graph IV
8243 call transpose2(EE(1,1,itj),auxmat(1,1))
8244 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8245 vv(1)=pizda(1,1)+pizda(2,2)
8246 vv(2)=pizda(2,1)-pizda(1,2)
8247 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
8248 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8249 C Explicit gradient in virtual-dihedral angles.
8250 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8251 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8252 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8253 vv(1)=pizda(1,1)+pizda(2,2)
8254 vv(2)=pizda(2,1)-pizda(1,2)
8255 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8256 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
8257 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8258 C Cartesian gradient
8262 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8264 vv(1)=pizda(1,1)+pizda(2,2)
8265 vv(2)=pizda(2,1)-pizda(1,2)
8266 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8267 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
8268 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8274 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8275 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8276 cd write (2,*) 'ijkl',i,j,k,l
8277 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8278 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8280 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8281 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8282 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8283 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8284 if (j.lt.nres-1) then
8291 if (l.lt.nres-1) then
8301 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8302 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8303 C summed up outside the subrouine as for the other subroutines
8304 C handling long-range interactions. The old code is commented out
8305 C with "cgrad" to keep track of changes.
8307 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8308 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8309 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8310 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8311 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8312 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8313 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8314 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8315 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8316 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8318 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8319 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8320 cgrad ghalf=0.5d0*ggg1(ll)
8322 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8323 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8324 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8325 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8326 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8327 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8328 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8329 cgrad ghalf=0.5d0*ggg2(ll)
8331 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8332 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8333 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8334 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8335 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8336 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8341 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8342 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8347 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8348 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8354 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8359 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8363 cd write (2,*) iii,g_corr5_loc(iii)
8366 cd write (2,*) 'ekont',ekont
8367 cd write (iout,*) 'eello5',ekont*eel5
8370 c--------------------------------------------------------------------------
8371 double precision function eello6(i,j,k,l,jj,kk)
8372 implicit real*8 (a-h,o-z)
8373 include 'DIMENSIONS'
8374 include 'COMMON.IOUNITS'
8375 include 'COMMON.CHAIN'
8376 include 'COMMON.DERIV'
8377 include 'COMMON.INTERACT'
8378 include 'COMMON.CONTACTS'
8379 include 'COMMON.TORSION'
8380 include 'COMMON.VAR'
8381 include 'COMMON.GEO'
8382 include 'COMMON.FFIELD'
8383 double precision ggg1(3),ggg2(3)
8384 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8389 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8397 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8398 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8402 derx(lll,kkk,iii)=0.0d0
8406 cd eij=facont_hb(jj,i)
8407 cd ekl=facont_hb(kk,k)
8413 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8414 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8415 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8416 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8417 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8418 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8420 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8421 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8422 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8423 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8424 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8425 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8429 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8431 C If turn contributions are considered, they will be handled separately.
8432 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8433 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8434 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8435 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8436 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8437 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8438 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8440 if (j.lt.nres-1) then
8447 if (l.lt.nres-1) then
8455 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8456 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8457 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8458 cgrad ghalf=0.5d0*ggg1(ll)
8460 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8461 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8462 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8463 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8464 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8465 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8466 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8467 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8468 cgrad ghalf=0.5d0*ggg2(ll)
8469 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8471 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8472 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8473 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8474 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8475 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8476 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8481 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8482 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8487 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8488 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8494 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8499 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8503 cd write (2,*) iii,g_corr6_loc(iii)
8506 cd write (2,*) 'ekont',ekont
8507 cd write (iout,*) 'eello6',ekont*eel6
8510 c--------------------------------------------------------------------------
8511 double precision function eello6_graph1(i,j,k,l,imat,swap)
8512 implicit real*8 (a-h,o-z)
8513 include 'DIMENSIONS'
8514 include 'COMMON.IOUNITS'
8515 include 'COMMON.CHAIN'
8516 include 'COMMON.DERIV'
8517 include 'COMMON.INTERACT'
8518 include 'COMMON.CONTACTS'
8519 include 'COMMON.TORSION'
8520 include 'COMMON.VAR'
8521 include 'COMMON.GEO'
8522 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8526 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8528 C Parallel Antiparallel C
8534 C \ j|/k\| / \ |/k\|l / C
8539 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8540 itk=itortyp(itype(k))
8541 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8542 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8543 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8544 call transpose2(EUgC(1,1,k),auxmat(1,1))
8545 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8546 vv1(1)=pizda1(1,1)-pizda1(2,2)
8547 vv1(2)=pizda1(1,2)+pizda1(2,1)
8548 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8549 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8550 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8551 s5=scalar2(vv(1),Dtobr2(1,i))
8552 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8553 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8554 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8555 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8556 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8557 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8558 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8559 & +scalar2(vv(1),Dtobr2der(1,i)))
8560 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8561 vv1(1)=pizda1(1,1)-pizda1(2,2)
8562 vv1(2)=pizda1(1,2)+pizda1(2,1)
8563 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8564 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8566 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8567 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8568 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8569 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8570 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8572 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8573 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8574 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8575 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8576 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8578 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8579 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8580 vv1(1)=pizda1(1,1)-pizda1(2,2)
8581 vv1(2)=pizda1(1,2)+pizda1(2,1)
8582 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8583 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8584 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8585 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8594 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8595 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8596 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8597 call transpose2(EUgC(1,1,k),auxmat(1,1))
8598 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8600 vv1(1)=pizda1(1,1)-pizda1(2,2)
8601 vv1(2)=pizda1(1,2)+pizda1(2,1)
8602 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8603 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8604 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8605 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8606 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8607 s5=scalar2(vv(1),Dtobr2(1,i))
8608 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8614 c----------------------------------------------------------------------------
8615 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8616 implicit real*8 (a-h,o-z)
8617 include 'DIMENSIONS'
8618 include 'COMMON.IOUNITS'
8619 include 'COMMON.CHAIN'
8620 include 'COMMON.DERIV'
8621 include 'COMMON.INTERACT'
8622 include 'COMMON.CONTACTS'
8623 include 'COMMON.TORSION'
8624 include 'COMMON.VAR'
8625 include 'COMMON.GEO'
8627 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8628 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8631 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8633 C Parallel Antiparallel C
8639 C \ j|/k\| \ |/k\|l C
8644 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8645 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8646 C AL 7/4/01 s1 would occur in the sixth-order moment,
8647 C but not in a cluster cumulant
8649 s1=dip(1,jj,i)*dip(1,kk,k)
8651 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8652 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8653 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8654 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8655 call transpose2(EUg(1,1,k),auxmat(1,1))
8656 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8657 vv(1)=pizda(1,1)-pizda(2,2)
8658 vv(2)=pizda(1,2)+pizda(2,1)
8659 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8660 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8662 eello6_graph2=-(s1+s2+s3+s4)
8664 eello6_graph2=-(s2+s3+s4)
8667 C Derivatives in gamma(i-1)
8670 s1=dipderg(1,jj,i)*dip(1,kk,k)
8672 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8673 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8674 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8675 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8677 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8679 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8681 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8683 C Derivatives in gamma(k-1)
8685 s1=dip(1,jj,i)*dipderg(1,kk,k)
8687 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8688 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8689 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8690 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8691 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8692 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8693 vv(1)=pizda(1,1)-pizda(2,2)
8694 vv(2)=pizda(1,2)+pizda(2,1)
8695 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8697 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8699 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8701 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8702 C Derivatives in gamma(j-1) or gamma(l-1)
8705 s1=dipderg(3,jj,i)*dip(1,kk,k)
8707 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8708 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8709 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8710 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8711 vv(1)=pizda(1,1)-pizda(2,2)
8712 vv(2)=pizda(1,2)+pizda(2,1)
8713 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8716 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8718 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8721 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8722 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8724 C Derivatives in gamma(l-1) or gamma(j-1)
8727 s1=dip(1,jj,i)*dipderg(3,kk,k)
8729 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8730 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8731 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8732 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8733 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8734 vv(1)=pizda(1,1)-pizda(2,2)
8735 vv(2)=pizda(1,2)+pizda(2,1)
8736 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8739 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8741 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8744 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8745 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8747 C Cartesian derivatives.
8749 write (2,*) 'In eello6_graph2'
8751 write (2,*) 'iii=',iii
8753 write (2,*) 'kkk=',kkk
8755 write (2,'(3(2f10.5),5x)')
8756 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8766 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8768 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8771 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8773 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8774 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8776 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8777 call transpose2(EUg(1,1,k),auxmat(1,1))
8778 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8780 vv(1)=pizda(1,1)-pizda(2,2)
8781 vv(2)=pizda(1,2)+pizda(2,1)
8782 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8783 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8785 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8787 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8790 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8792 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8799 c----------------------------------------------------------------------------
8800 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8801 implicit real*8 (a-h,o-z)
8802 include 'DIMENSIONS'
8803 include 'COMMON.IOUNITS'
8804 include 'COMMON.CHAIN'
8805 include 'COMMON.DERIV'
8806 include 'COMMON.INTERACT'
8807 include 'COMMON.CONTACTS'
8808 include 'COMMON.TORSION'
8809 include 'COMMON.VAR'
8810 include 'COMMON.GEO'
8811 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8813 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8815 C Parallel Antiparallel C
8821 C j|/k\| / |/k\|l / C
8826 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8828 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8829 C energy moment and not to the cluster cumulant.
8830 iti=itortyp(itype(i))
8831 if (j.lt.nres-1) then
8832 itj1=itortyp(itype(j+1))
8836 itk=itortyp(itype(k))
8837 itk1=itortyp(itype(k+1))
8838 if (l.lt.nres-1) then
8839 itl1=itortyp(itype(l+1))
8844 s1=dip(4,jj,i)*dip(4,kk,k)
8846 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8847 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8848 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8849 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8850 call transpose2(EE(1,1,itk),auxmat(1,1))
8851 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8852 vv(1)=pizda(1,1)+pizda(2,2)
8853 vv(2)=pizda(2,1)-pizda(1,2)
8854 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8855 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8856 cd & "sum",-(s2+s3+s4)
8858 eello6_graph3=-(s1+s2+s3+s4)
8860 eello6_graph3=-(s2+s3+s4)
8863 C Derivatives in gamma(k-1)
8864 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8865 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8866 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8867 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8868 C Derivatives in gamma(l-1)
8869 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8870 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8871 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8872 vv(1)=pizda(1,1)+pizda(2,2)
8873 vv(2)=pizda(2,1)-pizda(1,2)
8874 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8875 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8876 C Cartesian derivatives.
8882 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8884 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8887 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8889 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8890 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8892 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8893 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8895 vv(1)=pizda(1,1)+pizda(2,2)
8896 vv(2)=pizda(2,1)-pizda(1,2)
8897 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8899 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8901 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8904 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8906 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8908 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8914 c----------------------------------------------------------------------------
8915 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8916 implicit real*8 (a-h,o-z)
8917 include 'DIMENSIONS'
8918 include 'COMMON.IOUNITS'
8919 include 'COMMON.CHAIN'
8920 include 'COMMON.DERIV'
8921 include 'COMMON.INTERACT'
8922 include 'COMMON.CONTACTS'
8923 include 'COMMON.TORSION'
8924 include 'COMMON.VAR'
8925 include 'COMMON.GEO'
8926 include 'COMMON.FFIELD'
8927 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8928 & auxvec1(2),auxmat1(2,2)
8930 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8932 C Parallel Antiparallel C
8938 C \ j|/k\| \ |/k\|l C
8943 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8945 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8946 C energy moment and not to the cluster cumulant.
8947 cd write (2,*) 'eello_graph4: wturn6',wturn6
8948 iti=itortyp(itype(i))
8949 itj=itortyp(itype(j))
8950 if (j.lt.nres-1) then
8951 itj1=itortyp(itype(j+1))
8955 itk=itortyp(itype(k))
8956 if (k.lt.nres-1) then
8957 itk1=itortyp(itype(k+1))
8961 itl=itortyp(itype(l))
8962 if (l.lt.nres-1) then
8963 itl1=itortyp(itype(l+1))
8967 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8968 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8969 cd & ' itl',itl,' itl1',itl1
8972 s1=dip(3,jj,i)*dip(3,kk,k)
8974 s1=dip(2,jj,j)*dip(2,kk,l)
8977 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8978 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8980 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8981 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8983 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8984 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8986 call transpose2(EUg(1,1,k),auxmat(1,1))
8987 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8988 vv(1)=pizda(1,1)-pizda(2,2)
8989 vv(2)=pizda(2,1)+pizda(1,2)
8990 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8991 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8993 eello6_graph4=-(s1+s2+s3+s4)
8995 eello6_graph4=-(s2+s3+s4)
8997 C Derivatives in gamma(i-1)
9001 s1=dipderg(2,jj,i)*dip(3,kk,k)
9003 s1=dipderg(4,jj,j)*dip(2,kk,l)
9006 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9008 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
9009 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9011 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
9012 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9014 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9015 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9016 cd write (2,*) 'turn6 derivatives'
9018 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9020 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9024 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9026 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9030 C Derivatives in gamma(k-1)
9033 s1=dip(3,jj,i)*dipderg(2,kk,k)
9035 s1=dip(2,jj,j)*dipderg(4,kk,l)
9038 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9039 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9041 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
9042 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9044 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
9045 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9047 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9048 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9049 vv(1)=pizda(1,1)-pizda(2,2)
9050 vv(2)=pizda(2,1)+pizda(1,2)
9051 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9052 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9054 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9056 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9060 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9062 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9065 C Derivatives in gamma(j-1) or gamma(l-1)
9066 if (l.eq.j+1 .and. l.gt.1) then
9067 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9068 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9069 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9070 vv(1)=pizda(1,1)-pizda(2,2)
9071 vv(2)=pizda(2,1)+pizda(1,2)
9072 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9073 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9074 else if (j.gt.1) then
9075 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9076 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9077 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9078 vv(1)=pizda(1,1)-pizda(2,2)
9079 vv(2)=pizda(2,1)+pizda(1,2)
9080 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9081 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9082 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9084 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9087 C Cartesian derivatives.
9094 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9096 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9100 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9102 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9106 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9108 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9110 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9111 & b1(1,itj1),auxvec(1))
9112 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
9114 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9115 & b1(1,itl1),auxvec(1))
9116 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
9118 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9120 vv(1)=pizda(1,1)-pizda(2,2)
9121 vv(2)=pizda(2,1)+pizda(1,2)
9122 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9124 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9126 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9129 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9132 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9135 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9137 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9139 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9143 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9145 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9148 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9150 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9158 c----------------------------------------------------------------------------
9159 double precision function eello_turn6(i,jj,kk)
9160 implicit real*8 (a-h,o-z)
9161 include 'DIMENSIONS'
9162 include 'COMMON.IOUNITS'
9163 include 'COMMON.CHAIN'
9164 include 'COMMON.DERIV'
9165 include 'COMMON.INTERACT'
9166 include 'COMMON.CONTACTS'
9167 include 'COMMON.TORSION'
9168 include 'COMMON.VAR'
9169 include 'COMMON.GEO'
9170 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9171 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9173 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9174 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9175 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9176 C the respective energy moment and not to the cluster cumulant.
9185 iti=itortyp(itype(i))
9186 itk=itortyp(itype(k))
9187 itk1=itortyp(itype(k+1))
9188 itl=itortyp(itype(l))
9189 itj=itortyp(itype(j))
9190 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9191 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9192 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9197 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9199 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9203 derx_turn(lll,kkk,iii)=0.0d0
9210 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9212 cd write (2,*) 'eello6_5',eello6_5
9214 call transpose2(AEA(1,1,1),auxmat(1,1))
9215 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9216 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9217 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9219 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9220 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9221 s2 = scalar2(b1(1,itk),vtemp1(1))
9223 call transpose2(AEA(1,1,2),atemp(1,1))
9224 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9225 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9226 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9228 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9229 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9230 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9232 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9233 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9234 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9235 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9236 ss13 = scalar2(b1(1,itk),vtemp4(1))
9237 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9239 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9245 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9246 C Derivatives in gamma(i+2)
9250 call transpose2(AEA(1,1,1),auxmatd(1,1))
9251 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9252 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9253 call transpose2(AEAderg(1,1,2),atempd(1,1))
9254 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9255 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9257 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9258 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9259 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9265 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9266 C Derivatives in gamma(i+3)
9268 call transpose2(AEA(1,1,1),auxmatd(1,1))
9269 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9270 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9271 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9273 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9274 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9275 s2d = scalar2(b1(1,itk),vtemp1d(1))
9277 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9278 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9280 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9282 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9283 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9284 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9292 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9293 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9295 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9296 & -0.5d0*ekont*(s2d+s12d)
9298 C Derivatives in gamma(i+4)
9299 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9300 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9301 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9303 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9304 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9305 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9313 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9315 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9317 C Derivatives in gamma(i+5)
9319 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9320 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9321 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9323 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9324 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9325 s2d = scalar2(b1(1,itk),vtemp1d(1))
9327 call transpose2(AEA(1,1,2),atempd(1,1))
9328 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9329 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9331 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9332 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9334 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9335 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9336 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9344 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9345 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9347 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9348 & -0.5d0*ekont*(s2d+s12d)
9350 C Cartesian derivatives
9355 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9356 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9357 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9359 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9360 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9362 s2d = scalar2(b1(1,itk),vtemp1d(1))
9364 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9365 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9366 s8d = -(atempd(1,1)+atempd(2,2))*
9367 & scalar2(cc(1,1,itl),vtemp2(1))
9369 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9371 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9372 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9379 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9382 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9386 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9387 & - 0.5d0*(s8d+s12d)
9389 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9398 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9400 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9401 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9402 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9403 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9404 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9406 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9407 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9408 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9412 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9413 cd & 16*eel_turn6_num
9415 if (j.lt.nres-1) then
9422 if (l.lt.nres-1) then
9430 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9431 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9432 cgrad ghalf=0.5d0*ggg1(ll)
9434 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9435 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9436 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9437 & +ekont*derx_turn(ll,2,1)
9438 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9439 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9440 & +ekont*derx_turn(ll,4,1)
9441 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9442 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9443 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9444 cgrad ghalf=0.5d0*ggg2(ll)
9446 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9447 & +ekont*derx_turn(ll,2,2)
9448 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9449 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9450 & +ekont*derx_turn(ll,4,2)
9451 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9452 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9453 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9458 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9463 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9469 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9474 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9478 cd write (2,*) iii,g_corr6_loc(iii)
9480 eello_turn6=ekont*eel_turn6
9481 cd write (2,*) 'ekont',ekont
9482 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9486 C-----------------------------------------------------------------------------
9487 double precision function scalar(u,v)
9488 !DIR$ INLINEALWAYS scalar
9490 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9493 double precision u(3),v(3)
9494 cd double precision sc
9502 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9505 crc-------------------------------------------------
9506 SUBROUTINE MATVEC2(A1,V1,V2)
9507 !DIR$ INLINEALWAYS MATVEC2
9509 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9511 implicit real*8 (a-h,o-z)
9512 include 'DIMENSIONS'
9513 DIMENSION A1(2,2),V1(2),V2(2)
9517 c 3 VI=VI+A1(I,K)*V1(K)
9521 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9522 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9527 C---------------------------------------
9528 SUBROUTINE MATMAT2(A1,A2,A3)
9530 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9532 implicit real*8 (a-h,o-z)
9533 include 'DIMENSIONS'
9534 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9535 c DIMENSION AI3(2,2)
9539 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9545 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9546 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9547 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9548 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9556 c-------------------------------------------------------------------------
9557 double precision function scalar2(u,v)
9558 !DIR$ INLINEALWAYS scalar2
9560 double precision u(2),v(2)
9563 scalar2=u(1)*v(1)+u(2)*v(2)
9567 C-----------------------------------------------------------------------------
9569 subroutine transpose2(a,at)
9570 !DIR$ INLINEALWAYS transpose2
9572 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9575 double precision a(2,2),at(2,2)
9582 c--------------------------------------------------------------------------
9583 subroutine transpose(n,a,at)
9586 double precision a(n,n),at(n,n)
9594 C---------------------------------------------------------------------------
9595 subroutine prodmat3(a1,a2,kk,transp,prod)
9596 !DIR$ INLINEALWAYS prodmat3
9598 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9602 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9604 crc double precision auxmat(2,2),prod_(2,2)
9607 crc call transpose2(kk(1,1),auxmat(1,1))
9608 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9609 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9611 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9612 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9613 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9614 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9615 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9616 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9617 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9618 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9621 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9622 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9624 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9625 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9626 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9627 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9628 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9629 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9630 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9631 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9634 c call transpose2(a2(1,1),a2t(1,1))
9637 crc print *,((prod_(i,j),i=1,2),j=1,2)
9638 crc print *,((prod(i,j),i=1,2),j=1,2)