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 cd 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
2029 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2030 do j=ielstart(i),ielend(i)
2031 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2035 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2036 r0ij=rpp(iteli,itelj)
2041 xj=c(1,j)+0.5D0*dxj-xmedi
2042 yj=c(2,j)+0.5D0*dyj-ymedi
2043 zj=c(3,j)+0.5D0*dzj-zmedi
2044 rij=xj*xj+yj*yj+zj*zj
2045 if (rij.lt.r0ijsq) then
2046 evdw1ij=0.25d0*(rij-r0ijsq)**2
2054 C Calculate contributions to the Cartesian gradient.
2060 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2061 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2064 * Loop over residues i+1 thru j-1.
2068 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2073 cgrad do i=nnt,nct-1
2075 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2077 cgrad do j=i+1,nct-1
2079 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2085 c------------------------------------------------------------------------------
2086 subroutine vec_and_deriv
2087 implicit real*8 (a-h,o-z)
2088 include 'DIMENSIONS'
2092 include 'COMMON.IOUNITS'
2093 include 'COMMON.GEO'
2094 include 'COMMON.VAR'
2095 include 'COMMON.LOCAL'
2096 include 'COMMON.CHAIN'
2097 include 'COMMON.VECTORS'
2098 include 'COMMON.SETUP'
2099 include 'COMMON.TIME1'
2100 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2101 C Compute the local reference systems. For reference system (i), the
2102 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2103 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2105 do i=ivec_start,ivec_end
2109 if (i.eq.nres-1) then
2110 C Case of the last full residue
2111 C Compute the Z-axis
2112 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2113 costh=dcos(pi-theta(nres))
2114 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2118 C Compute the derivatives of uz
2120 uzder(2,1,1)=-dc_norm(3,i-1)
2121 uzder(3,1,1)= dc_norm(2,i-1)
2122 uzder(1,2,1)= dc_norm(3,i-1)
2124 uzder(3,2,1)=-dc_norm(1,i-1)
2125 uzder(1,3,1)=-dc_norm(2,i-1)
2126 uzder(2,3,1)= dc_norm(1,i-1)
2129 uzder(2,1,2)= dc_norm(3,i)
2130 uzder(3,1,2)=-dc_norm(2,i)
2131 uzder(1,2,2)=-dc_norm(3,i)
2133 uzder(3,2,2)= dc_norm(1,i)
2134 uzder(1,3,2)= dc_norm(2,i)
2135 uzder(2,3,2)=-dc_norm(1,i)
2137 C Compute the Y-axis
2140 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2142 C Compute the derivatives of uy
2145 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2146 & -dc_norm(k,i)*dc_norm(j,i-1)
2147 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2149 uyder(j,j,1)=uyder(j,j,1)-costh
2150 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2155 uygrad(l,k,j,i)=uyder(l,k,j)
2156 uzgrad(l,k,j,i)=uzder(l,k,j)
2160 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2161 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2162 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2163 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2166 C Compute the Z-axis
2167 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2168 costh=dcos(pi-theta(i+2))
2169 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2173 C Compute the derivatives of uz
2175 uzder(2,1,1)=-dc_norm(3,i+1)
2176 uzder(3,1,1)= dc_norm(2,i+1)
2177 uzder(1,2,1)= dc_norm(3,i+1)
2179 uzder(3,2,1)=-dc_norm(1,i+1)
2180 uzder(1,3,1)=-dc_norm(2,i+1)
2181 uzder(2,3,1)= dc_norm(1,i+1)
2184 uzder(2,1,2)= dc_norm(3,i)
2185 uzder(3,1,2)=-dc_norm(2,i)
2186 uzder(1,2,2)=-dc_norm(3,i)
2188 uzder(3,2,2)= dc_norm(1,i)
2189 uzder(1,3,2)= dc_norm(2,i)
2190 uzder(2,3,2)=-dc_norm(1,i)
2192 C Compute the Y-axis
2195 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2197 C Compute the derivatives of uy
2200 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2201 & -dc_norm(k,i)*dc_norm(j,i+1)
2202 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2204 uyder(j,j,1)=uyder(j,j,1)-costh
2205 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2210 uygrad(l,k,j,i)=uyder(l,k,j)
2211 uzgrad(l,k,j,i)=uzder(l,k,j)
2215 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2216 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2217 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2218 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2222 vbld_inv_temp(1)=vbld_inv(i+1)
2223 if (i.lt.nres-1) then
2224 vbld_inv_temp(2)=vbld_inv(i+2)
2226 vbld_inv_temp(2)=vbld_inv(i)
2231 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2232 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2237 #if defined(PARVEC) && defined(MPI)
2238 if (nfgtasks1.gt.1) then
2240 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2241 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2242 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2243 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2244 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2246 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2247 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2249 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2250 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2251 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2252 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2253 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2254 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2255 time_gather=time_gather+MPI_Wtime()-time00
2257 c if (fg_rank.eq.0) then
2258 c write (iout,*) "Arrays UY and UZ"
2260 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2267 C-----------------------------------------------------------------------------
2268 subroutine check_vecgrad
2269 implicit real*8 (a-h,o-z)
2270 include 'DIMENSIONS'
2271 include 'COMMON.IOUNITS'
2272 include 'COMMON.GEO'
2273 include 'COMMON.VAR'
2274 include 'COMMON.LOCAL'
2275 include 'COMMON.CHAIN'
2276 include 'COMMON.VECTORS'
2277 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2278 dimension uyt(3,maxres),uzt(3,maxres)
2279 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2280 double precision delta /1.0d-7/
2283 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2284 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2285 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2286 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2287 cd & (dc_norm(if90,i),if90=1,3)
2288 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2289 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2290 cd write(iout,'(a)')
2296 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2297 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2310 cd write (iout,*) 'i=',i
2312 erij(k)=dc_norm(k,i)
2316 dc_norm(k,i)=erij(k)
2318 dc_norm(j,i)=dc_norm(j,i)+delta
2319 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2321 c dc_norm(k,i)=dc_norm(k,i)/fac
2323 c write (iout,*) (dc_norm(k,i),k=1,3)
2324 c write (iout,*) (erij(k),k=1,3)
2327 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2328 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2329 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2330 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2332 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2333 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2334 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2337 dc_norm(k,i)=erij(k)
2340 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2341 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2342 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2343 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2344 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2345 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2346 cd write (iout,'(a)')
2351 C--------------------------------------------------------------------------
2352 subroutine set_matrices
2353 implicit real*8 (a-h,o-z)
2354 include 'DIMENSIONS'
2357 include "COMMON.SETUP"
2359 integer status(MPI_STATUS_SIZE)
2361 include 'COMMON.IOUNITS'
2362 include 'COMMON.GEO'
2363 include 'COMMON.VAR'
2364 include 'COMMON.LOCAL'
2365 include 'COMMON.CHAIN'
2366 include 'COMMON.DERIV'
2367 include 'COMMON.INTERACT'
2368 include 'COMMON.CONTACTS'
2369 include 'COMMON.TORSION'
2370 include 'COMMON.VECTORS'
2371 include 'COMMON.FFIELD'
2372 double precision auxvec(2),auxmat(2,2)
2374 C Compute the virtual-bond-torsional-angle dependent quantities needed
2375 C to calculate the el-loc multibody terms of various order.
2378 do i=ivec_start+2,ivec_end+2
2382 if (i .lt. nres+1) then
2419 if (i .gt. 3 .and. i .lt. nres+1) then
2420 obrot_der(1,i-2)=-sin1
2421 obrot_der(2,i-2)= cos1
2422 Ugder(1,1,i-2)= sin1
2423 Ugder(1,2,i-2)=-cos1
2424 Ugder(2,1,i-2)=-cos1
2425 Ugder(2,2,i-2)=-sin1
2428 obrot2_der(1,i-2)=-dwasin2
2429 obrot2_der(2,i-2)= dwacos2
2430 Ug2der(1,1,i-2)= dwasin2
2431 Ug2der(1,2,i-2)=-dwacos2
2432 Ug2der(2,1,i-2)=-dwacos2
2433 Ug2der(2,2,i-2)=-dwasin2
2435 obrot_der(1,i-2)=0.0d0
2436 obrot_der(2,i-2)=0.0d0
2437 Ugder(1,1,i-2)=0.0d0
2438 Ugder(1,2,i-2)=0.0d0
2439 Ugder(2,1,i-2)=0.0d0
2440 Ugder(2,2,i-2)=0.0d0
2441 obrot2_der(1,i-2)=0.0d0
2442 obrot2_der(2,i-2)=0.0d0
2443 Ug2der(1,1,i-2)=0.0d0
2444 Ug2der(1,2,i-2)=0.0d0
2445 Ug2der(2,1,i-2)=0.0d0
2446 Ug2der(2,2,i-2)=0.0d0
2448 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2449 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2450 iti = itortyp(itype(i-2))
2454 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2455 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2456 iti1 = itortyp(itype(i-1))
2460 cd write (iout,*) '*******i',i,' iti1',iti
2461 cd write (iout,*) 'b1',b1(:,iti)
2462 cd write (iout,*) 'b2',b2(:,iti)
2463 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2464 c if (i .gt. iatel_s+2) then
2465 if (i .gt. nnt+2) then
2466 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2467 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2468 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2470 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2471 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2472 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2473 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2474 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2485 DtUg2(l,k,i-2)=0.0d0
2489 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2490 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2492 muder(k,i-2)=Ub2der(k,i-2)
2494 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2495 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2496 if (itype(i-1).le.ntyp) then
2497 iti1 = itortyp(itype(i-1))
2505 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2507 cd write (iout,*) 'mu ',mu(:,i-2)
2508 cd write (iout,*) 'mu1',mu1(:,i-2)
2509 cd write (iout,*) 'mu2',mu2(:,i-2)
2510 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2512 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2513 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2514 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2515 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2516 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2517 C Vectors and matrices dependent on a single virtual-bond dihedral.
2518 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2519 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2520 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2521 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2522 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2523 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2524 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2525 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2526 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2529 C Matrices dependent on two consecutive virtual-bond dihedrals.
2530 C The order of matrices is from left to right.
2531 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2533 c do i=max0(ivec_start,2),ivec_end
2535 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2536 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2537 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2538 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2539 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2540 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2541 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2542 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2545 #if defined(MPI) && defined(PARMAT)
2547 c if (fg_rank.eq.0) then
2548 write (iout,*) "Arrays UG and UGDER before GATHER"
2550 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2551 & ((ug(l,k,i),l=1,2),k=1,2),
2552 & ((ugder(l,k,i),l=1,2),k=1,2)
2554 write (iout,*) "Arrays UG2 and UG2DER"
2556 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2557 & ((ug2(l,k,i),l=1,2),k=1,2),
2558 & ((ug2der(l,k,i),l=1,2),k=1,2)
2560 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2562 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2563 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2564 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2566 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2568 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2569 & costab(i),sintab(i),costab2(i),sintab2(i)
2571 write (iout,*) "Array MUDER"
2573 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2577 if (nfgtasks.gt.1) then
2579 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2580 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2581 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2583 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2584 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2586 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2587 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2589 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2590 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2592 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2593 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2595 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2596 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2598 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2599 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2601 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2602 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2603 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2604 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2605 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2606 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2607 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2608 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2609 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2610 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2611 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2612 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2613 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2615 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2616 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2618 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2619 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2621 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2622 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2624 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2625 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2627 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2628 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2630 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2631 & ivec_count(fg_rank1),
2632 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2634 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2635 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2637 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2638 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2640 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2641 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2643 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2644 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2646 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2647 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2649 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2650 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2652 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2653 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2655 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2656 & ivec_count(fg_rank1),
2657 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2659 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2660 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2662 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2663 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2665 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2666 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2668 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2669 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2671 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2672 & ivec_count(fg_rank1),
2673 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2675 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2676 & ivec_count(fg_rank1),
2677 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2679 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2680 & ivec_count(fg_rank1),
2681 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2682 & MPI_MAT2,FG_COMM1,IERR)
2683 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2684 & ivec_count(fg_rank1),
2685 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2686 & MPI_MAT2,FG_COMM1,IERR)
2689 c Passes matrix info through the ring
2692 if (irecv.lt.0) irecv=nfgtasks1-1
2695 if (inext.ge.nfgtasks1) inext=0
2697 c write (iout,*) "isend",isend," irecv",irecv
2699 lensend=lentyp(isend)
2700 lenrecv=lentyp(irecv)
2701 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2702 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2703 c & MPI_ROTAT1(lensend),inext,2200+isend,
2704 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2705 c & iprev,2200+irecv,FG_COMM,status,IERR)
2706 c write (iout,*) "Gather ROTAT1"
2708 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2709 c & MPI_ROTAT2(lensend),inext,3300+isend,
2710 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2711 c & iprev,3300+irecv,FG_COMM,status,IERR)
2712 c write (iout,*) "Gather ROTAT2"
2714 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2715 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2716 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2717 & iprev,4400+irecv,FG_COMM,status,IERR)
2718 c write (iout,*) "Gather ROTAT_OLD"
2720 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2721 & MPI_PRECOMP11(lensend),inext,5500+isend,
2722 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2723 & iprev,5500+irecv,FG_COMM,status,IERR)
2724 c write (iout,*) "Gather PRECOMP11"
2726 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2727 & MPI_PRECOMP12(lensend),inext,6600+isend,
2728 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2729 & iprev,6600+irecv,FG_COMM,status,IERR)
2730 c write (iout,*) "Gather PRECOMP12"
2732 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2734 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2735 & MPI_ROTAT2(lensend),inext,7700+isend,
2736 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2737 & iprev,7700+irecv,FG_COMM,status,IERR)
2738 c write (iout,*) "Gather PRECOMP21"
2740 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2741 & MPI_PRECOMP22(lensend),inext,8800+isend,
2742 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2743 & iprev,8800+irecv,FG_COMM,status,IERR)
2744 c write (iout,*) "Gather PRECOMP22"
2746 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2747 & MPI_PRECOMP23(lensend),inext,9900+isend,
2748 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2749 & MPI_PRECOMP23(lenrecv),
2750 & iprev,9900+irecv,FG_COMM,status,IERR)
2751 c write (iout,*) "Gather PRECOMP23"
2756 if (irecv.lt.0) irecv=nfgtasks1-1
2759 time_gather=time_gather+MPI_Wtime()-time00
2762 c if (fg_rank.eq.0) then
2763 write (iout,*) "Arrays UG and UGDER"
2765 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2766 & ((ug(l,k,i),l=1,2),k=1,2),
2767 & ((ugder(l,k,i),l=1,2),k=1,2)
2769 write (iout,*) "Arrays UG2 and UG2DER"
2771 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2772 & ((ug2(l,k,i),l=1,2),k=1,2),
2773 & ((ug2der(l,k,i),l=1,2),k=1,2)
2775 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2777 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2778 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2779 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2781 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2783 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2784 & costab(i),sintab(i),costab2(i),sintab2(i)
2786 write (iout,*) "Array MUDER"
2788 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2794 cd iti = itortyp(itype(i))
2797 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2798 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2803 C--------------------------------------------------------------------------
2804 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2806 C This subroutine calculates the average interaction energy and its gradient
2807 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2808 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2809 C The potential depends both on the distance of peptide-group centers and on
2810 C the orientation of the CA-CA virtual bonds.
2812 implicit real*8 (a-h,o-z)
2816 include 'DIMENSIONS'
2817 include 'COMMON.CONTROL'
2818 include 'COMMON.SETUP'
2819 include 'COMMON.IOUNITS'
2820 include 'COMMON.GEO'
2821 include 'COMMON.VAR'
2822 include 'COMMON.LOCAL'
2823 include 'COMMON.CHAIN'
2824 include 'COMMON.DERIV'
2825 include 'COMMON.INTERACT'
2826 include 'COMMON.CONTACTS'
2827 include 'COMMON.TORSION'
2828 include 'COMMON.VECTORS'
2829 include 'COMMON.FFIELD'
2830 include 'COMMON.TIME1'
2831 include 'COMMON.SPLITELE'
2832 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2833 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2834 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2835 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2836 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2837 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2839 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2841 double precision scal_el /1.0d0/
2843 double precision scal_el /0.5d0/
2846 C 13-go grudnia roku pamietnego...
2847 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2848 & 0.0d0,1.0d0,0.0d0,
2849 & 0.0d0,0.0d0,1.0d0/
2850 cd write(iout,*) 'In EELEC'
2852 cd write(iout,*) 'Type',i
2853 cd write(iout,*) 'B1',B1(:,i)
2854 cd write(iout,*) 'B2',B2(:,i)
2855 cd write(iout,*) 'CC',CC(:,:,i)
2856 cd write(iout,*) 'DD',DD(:,:,i)
2857 cd write(iout,*) 'EE',EE(:,:,i)
2859 cd call check_vecgrad
2861 if (icheckgrad.eq.1) then
2863 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2865 dc_norm(k,i)=dc(k,i)*fac
2867 c write (iout,*) 'i',i,' fac',fac
2870 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2871 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2872 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2873 c call vec_and_deriv
2879 time_mat=time_mat+MPI_Wtime()-time01
2883 cd write (iout,*) 'i=',i
2885 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2888 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2889 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2902 cd print '(a)','Enter EELEC'
2903 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2905 gel_loc_loc(i)=0.0d0
2910 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2912 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2914 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
2915 do i=iturn3_start,iturn3_end
2916 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2917 & .or. itype(i+2).eq.ntyp1
2918 & .or. itype(i+3).eq.ntyp1
2919 & .or. itype(i-1).eq.ntyp1
2920 & .or. itype(i+4).eq.ntyp1
2925 dx_normi=dc_norm(1,i)
2926 dy_normi=dc_norm(2,i)
2927 dz_normi=dc_norm(3,i)
2928 xmedi=c(1,i)+0.5d0*dxi
2929 ymedi=c(2,i)+0.5d0*dyi
2930 zmedi=c(3,i)+0.5d0*dzi
2931 C Return atom into box, boxxsize is size of box in x dimension
2933 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2934 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2935 C Condition for being inside the proper box
2936 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
2937 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
2941 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
2942 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2943 cC Condition for being inside the proper box
2944 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
2945 c & (ymedi.lt.((-0.5d0)*boxysize))) then
2949 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2950 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2951 cC Condition for being inside the proper box
2952 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
2953 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
2956 xmedi=mod(xmedi,boxxsize)
2957 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2958 ymedi=mod(ymedi,boxysize)
2959 if (ymedi.lt.0) ymedi=ymedi+boxysize
2960 zmedi=mod(zmedi,boxzsize)
2961 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2963 call eelecij(i,i+2,ees,evdw1,eel_loc)
2964 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2965 num_cont_hb(i)=num_conti
2967 do i=iturn4_start,iturn4_end
2968 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2969 & .or. itype(i+3).eq.ntyp1
2970 & .or. itype(i+4).eq.ntyp1
2971 & .or. itype(i+5).eq.ntyp1
2972 & .or. itype(i).eq.ntyp1
2973 & .or. itype(i-1).eq.ntyp1
2978 dx_normi=dc_norm(1,i)
2979 dy_normi=dc_norm(2,i)
2980 dz_normi=dc_norm(3,i)
2981 xmedi=c(1,i)+0.5d0*dxi
2982 ymedi=c(2,i)+0.5d0*dyi
2983 zmedi=c(3,i)+0.5d0*dzi
2984 C Return atom into box, boxxsize is size of box in x dimension
2986 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2987 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2988 C Condition for being inside the proper box
2989 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
2990 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
2994 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
2995 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2996 C Condition for being inside the proper box
2997 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
2998 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3002 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3003 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3004 C Condition for being inside the proper box
3005 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3006 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3009 xmedi=mod(xmedi,boxxsize)
3010 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3011 ymedi=mod(ymedi,boxysize)
3012 if (ymedi.lt.0) ymedi=ymedi+boxysize
3013 zmedi=mod(zmedi,boxzsize)
3014 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3016 num_conti=num_cont_hb(i)
3017 call eelecij(i,i+3,ees,evdw1,eel_loc)
3018 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3019 & call eturn4(i,eello_turn4)
3020 num_cont_hb(i)=num_conti
3022 C Loop over all neighbouring boxes
3027 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3029 do i=iatel_s,iatel_e
3030 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3031 & .or. itype(i+2).eq.ntyp1
3032 & .or. itype(i-1).eq.ntyp1
3037 dx_normi=dc_norm(1,i)
3038 dy_normi=dc_norm(2,i)
3039 dz_normi=dc_norm(3,i)
3040 xmedi=c(1,i)+0.5d0*dxi
3041 ymedi=c(2,i)+0.5d0*dyi
3042 zmedi=c(3,i)+0.5d0*dzi
3043 xmedi=mod(xmedi,boxxsize)
3044 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3045 ymedi=mod(ymedi,boxysize)
3046 if (ymedi.lt.0) ymedi=ymedi+boxysize
3047 zmedi=mod(zmedi,boxzsize)
3048 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3049 C xmedi=xmedi+xshift*boxxsize
3050 C ymedi=ymedi+yshift*boxysize
3051 C zmedi=zmedi+zshift*boxzsize
3053 C Return tom into box, boxxsize is size of box in x dimension
3055 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3056 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3057 C Condition for being inside the proper box
3058 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3059 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3063 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3064 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3065 C Condition for being inside the proper box
3066 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3067 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3071 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3072 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3073 cC Condition for being inside the proper box
3074 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3075 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3079 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3080 num_conti=num_cont_hb(i)
3081 do j=ielstart(i),ielend(i)
3082 c write (iout,*) i,j,itype(i),itype(j)
3083 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3084 & .or.itype(j+2).eq.ntyp1
3085 & .or.itype(j-1).eq.ntyp1
3087 call eelecij(i,j,ees,evdw1,eel_loc)
3089 num_cont_hb(i)=num_conti
3095 c write (iout,*) "Number of loop steps in EELEC:",ind
3097 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3098 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3100 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3101 ccc eel_loc=eel_loc+eello_turn3
3102 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3105 C-------------------------------------------------------------------------------
3106 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3107 implicit real*8 (a-h,o-z)
3108 include 'DIMENSIONS'
3112 include 'COMMON.CONTROL'
3113 include 'COMMON.IOUNITS'
3114 include 'COMMON.GEO'
3115 include 'COMMON.VAR'
3116 include 'COMMON.LOCAL'
3117 include 'COMMON.CHAIN'
3118 include 'COMMON.DERIV'
3119 include 'COMMON.INTERACT'
3120 include 'COMMON.CONTACTS'
3121 include 'COMMON.TORSION'
3122 include 'COMMON.VECTORS'
3123 include 'COMMON.FFIELD'
3124 include 'COMMON.TIME1'
3125 include 'COMMON.SPLITELE'
3126 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3127 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3128 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3129 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3130 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3131 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3133 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3135 double precision scal_el /1.0d0/
3137 double precision scal_el /0.5d0/
3140 C 13-go grudnia roku pamietnego...
3141 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3142 & 0.0d0,1.0d0,0.0d0,
3143 & 0.0d0,0.0d0,1.0d0/
3144 c time00=MPI_Wtime()
3145 cd write (iout,*) "eelecij",i,j
3149 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3150 aaa=app(iteli,itelj)
3151 bbb=bpp(iteli,itelj)
3152 ael6i=ael6(iteli,itelj)
3153 ael3i=ael3(iteli,itelj)
3157 dx_normj=dc_norm(1,j)
3158 dy_normj=dc_norm(2,j)
3159 dz_normj=dc_norm(3,j)
3160 C xj=c(1,j)+0.5D0*dxj-xmedi
3161 C yj=c(2,j)+0.5D0*dyj-ymedi
3162 C zj=c(3,j)+0.5D0*dzj-zmedi
3167 if (xj.lt.0) xj=xj+boxxsize
3169 if (yj.lt.0) yj=yj+boxysize
3171 if (zj.lt.0) zj=zj+boxzsize
3172 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3180 xj=xj_safe+xshift*boxxsize
3181 yj=yj_safe+yshift*boxysize
3182 zj=zj_safe+zshift*boxzsize
3183 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3184 if(dist_temp.lt.dist_init) then
3194 if (isubchap.eq.1) then
3203 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3205 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3206 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3207 C Condition for being inside the proper box
3208 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3209 c & (xj.lt.((-0.5d0)*boxxsize))) then
3213 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3214 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3215 C Condition for being inside the proper box
3216 c if ((yj.gt.((0.5d0)*boxysize)).or.
3217 c & (yj.lt.((-0.5d0)*boxysize))) then
3221 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3222 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3223 C Condition for being inside the proper box
3224 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3225 c & (zj.lt.((-0.5d0)*boxzsize))) then
3228 C endif !endPBC condintion
3232 rij=xj*xj+yj*yj+zj*zj
3234 sss=sscale(sqrt(rij))
3235 sssgrad=sscagrad(sqrt(rij))
3236 c if (sss.gt.0.0d0) then
3242 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3243 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3244 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3245 fac=cosa-3.0D0*cosb*cosg
3247 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3248 if (j.eq.i+2) ev1=scal_el*ev1
3253 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3257 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3258 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3260 evdw1=evdw1+evdwij*sss
3261 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3262 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3263 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3264 cd & xmedi,ymedi,zmedi,xj,yj,zj
3266 if (energy_dec) then
3267 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3269 &,iteli,itelj,aaa,evdw1
3270 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3274 C Calculate contributions to the Cartesian gradient.
3277 facvdw=-6*rrmij*(ev1+evdwij)*sss
3278 facel=-3*rrmij*(el1+eesij)
3284 * Radial derivatives. First process both termini of the fragment (i,j)
3290 c ghalf=0.5D0*ggg(k)
3291 c gelc(k,i)=gelc(k,i)+ghalf
3292 c gelc(k,j)=gelc(k,j)+ghalf
3294 c 9/28/08 AL Gradient compotents will be summed only at the end
3296 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3297 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3300 * Loop over residues i+1 thru j-1.
3304 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3307 if (sss.gt.0.0) then
3308 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3309 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3310 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3317 c ghalf=0.5D0*ggg(k)
3318 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3319 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3321 c 9/28/08 AL Gradient compotents will be summed only at the end
3323 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3324 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3327 * Loop over residues i+1 thru j-1.
3331 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3336 facvdw=(ev1+evdwij)*sss
3339 fac=-3*rrmij*(facvdw+facvdw+facel)
3344 * Radial derivatives. First process both termini of the fragment (i,j)
3350 c ghalf=0.5D0*ggg(k)
3351 c gelc(k,i)=gelc(k,i)+ghalf
3352 c gelc(k,j)=gelc(k,j)+ghalf
3354 c 9/28/08 AL Gradient compotents will be summed only at the end
3356 gelc_long(k,j)=gelc(k,j)+ggg(k)
3357 gelc_long(k,i)=gelc(k,i)-ggg(k)
3360 * Loop over residues i+1 thru j-1.
3364 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3367 c 9/28/08 AL Gradient compotents will be summed only at the end
3368 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3369 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3370 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3372 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3373 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3379 ecosa=2.0D0*fac3*fac1+fac4
3382 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3383 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3385 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3386 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3388 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3389 cd & (dcosg(k),k=1,3)
3391 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3394 c ghalf=0.5D0*ggg(k)
3395 c gelc(k,i)=gelc(k,i)+ghalf
3396 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3397 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3398 c gelc(k,j)=gelc(k,j)+ghalf
3399 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3400 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3404 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3409 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3410 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3412 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3413 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3414 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3415 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3419 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3420 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3421 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3423 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3424 C energy of a peptide unit is assumed in the form of a second-order
3425 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3426 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3427 C are computed for EVERY pair of non-contiguous peptide groups.
3429 if (j.lt.nres-1) then
3440 muij(kkk)=mu(k,i)*mu(l,j)
3443 cd write (iout,*) 'EELEC: i',i,' j',j
3444 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3445 cd write(iout,*) 'muij',muij
3446 ury=scalar(uy(1,i),erij)
3447 urz=scalar(uz(1,i),erij)
3448 vry=scalar(uy(1,j),erij)
3449 vrz=scalar(uz(1,j),erij)
3450 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3451 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3452 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3453 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3454 fac=dsqrt(-ael6i)*r3ij
3459 cd write (iout,'(4i5,4f10.5)')
3460 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3461 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3462 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3463 cd & uy(:,j),uz(:,j)
3464 cd write (iout,'(4f10.5)')
3465 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3466 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3467 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3468 cd write (iout,'(9f10.5/)')
3469 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3470 C Derivatives of the elements of A in virtual-bond vectors
3471 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3473 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3474 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3475 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3476 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3477 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3478 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3479 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3480 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3481 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3482 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3483 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3484 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3486 C Compute radial contributions to the gradient
3504 C Add the contributions coming from er
3507 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3508 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3509 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3510 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3513 C Derivatives in DC(i)
3514 cgrad ghalf1=0.5d0*agg(k,1)
3515 cgrad ghalf2=0.5d0*agg(k,2)
3516 cgrad ghalf3=0.5d0*agg(k,3)
3517 cgrad ghalf4=0.5d0*agg(k,4)
3518 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3519 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3520 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3521 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3522 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3523 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3524 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3525 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3526 C Derivatives in DC(i+1)
3527 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3528 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3529 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3530 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3531 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3532 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3533 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3534 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3535 C Derivatives in DC(j)
3536 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3537 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3538 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3539 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3540 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3541 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3542 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3543 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3544 C Derivatives in DC(j+1) or DC(nres-1)
3545 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3546 & -3.0d0*vryg(k,3)*ury)
3547 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3548 & -3.0d0*vrzg(k,3)*ury)
3549 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3550 & -3.0d0*vryg(k,3)*urz)
3551 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3552 & -3.0d0*vrzg(k,3)*urz)
3553 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3555 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3568 aggi(k,l)=-aggi(k,l)
3569 aggi1(k,l)=-aggi1(k,l)
3570 aggj(k,l)=-aggj(k,l)
3571 aggj1(k,l)=-aggj1(k,l)
3574 if (j.lt.nres-1) then
3580 aggi(k,l)=-aggi(k,l)
3581 aggi1(k,l)=-aggi1(k,l)
3582 aggj(k,l)=-aggj(k,l)
3583 aggj1(k,l)=-aggj1(k,l)
3594 aggi(k,l)=-aggi(k,l)
3595 aggi1(k,l)=-aggi1(k,l)
3596 aggj(k,l)=-aggj(k,l)
3597 aggj1(k,l)=-aggj1(k,l)
3602 IF (wel_loc.gt.0.0d0) THEN
3603 C Contribution to the local-electrostatic energy coming from the i-j pair
3604 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3606 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3607 c & ' eel_loc_ij',eel_loc_ij
3609 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3610 & 'eelloc',i,j,eel_loc_ij
3611 c if (eel_loc_ij.ne.0)
3612 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3613 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3615 eel_loc=eel_loc+eel_loc_ij
3616 C Partial derivatives in virtual-bond dihedral angles gamma
3618 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3619 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3620 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3621 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3622 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3623 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3624 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3626 ggg(l)=agg(l,1)*muij(1)+
3627 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3628 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3629 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3630 cgrad ghalf=0.5d0*ggg(l)
3631 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3632 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3636 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3639 C Remaining derivatives of eello
3641 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3642 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3643 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3644 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3645 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3646 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3647 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3648 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3651 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3652 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3653 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3654 & .and. num_conti.le.maxconts) then
3655 c write (iout,*) i,j," entered corr"
3657 C Calculate the contact function. The ith column of the array JCONT will
3658 C contain the numbers of atoms that make contacts with the atom I (of numbers
3659 C greater than I). The arrays FACONT and GACONT will contain the values of
3660 C the contact function and its derivative.
3661 c r0ij=1.02D0*rpp(iteli,itelj)
3662 c r0ij=1.11D0*rpp(iteli,itelj)
3663 r0ij=2.20D0*rpp(iteli,itelj)
3664 c r0ij=1.55D0*rpp(iteli,itelj)
3665 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3666 if (fcont.gt.0.0D0) then
3667 num_conti=num_conti+1
3668 if (num_conti.gt.maxconts) then
3669 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3670 & ' will skip next contacts for this conf.'
3672 jcont_hb(num_conti,i)=j
3673 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3674 cd & " jcont_hb",jcont_hb(num_conti,i)
3675 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3676 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3677 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3679 d_cont(num_conti,i)=rij
3680 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3681 C --- Electrostatic-interaction matrix ---
3682 a_chuj(1,1,num_conti,i)=a22
3683 a_chuj(1,2,num_conti,i)=a23
3684 a_chuj(2,1,num_conti,i)=a32
3685 a_chuj(2,2,num_conti,i)=a33
3686 C --- Gradient of rij
3688 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3695 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3696 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3697 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3698 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3699 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3704 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3705 C Calculate contact energies
3707 wij=cosa-3.0D0*cosb*cosg
3710 c fac3=dsqrt(-ael6i)/r0ij**3
3711 fac3=dsqrt(-ael6i)*r3ij
3712 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3713 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3714 if (ees0tmp.gt.0) then
3715 ees0pij=dsqrt(ees0tmp)
3719 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3720 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3721 if (ees0tmp.gt.0) then
3722 ees0mij=dsqrt(ees0tmp)
3727 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3728 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3729 C Diagnostics. Comment out or remove after debugging!
3730 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3731 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3732 c ees0m(num_conti,i)=0.0D0
3734 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3735 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3736 C Angular derivatives of the contact function
3737 ees0pij1=fac3/ees0pij
3738 ees0mij1=fac3/ees0mij
3739 fac3p=-3.0D0*fac3*rrmij
3740 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3741 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3743 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3744 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3745 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3746 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3747 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3748 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3749 ecosap=ecosa1+ecosa2
3750 ecosbp=ecosb1+ecosb2
3751 ecosgp=ecosg1+ecosg2
3752 ecosam=ecosa1-ecosa2
3753 ecosbm=ecosb1-ecosb2
3754 ecosgm=ecosg1-ecosg2
3763 facont_hb(num_conti,i)=fcont
3764 fprimcont=fprimcont/rij
3765 cd facont_hb(num_conti,i)=1.0D0
3766 C Following line is for diagnostics.
3769 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3770 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3773 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3774 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3776 gggp(1)=gggp(1)+ees0pijp*xj
3777 gggp(2)=gggp(2)+ees0pijp*yj
3778 gggp(3)=gggp(3)+ees0pijp*zj
3779 gggm(1)=gggm(1)+ees0mijp*xj
3780 gggm(2)=gggm(2)+ees0mijp*yj
3781 gggm(3)=gggm(3)+ees0mijp*zj
3782 C Derivatives due to the contact function
3783 gacont_hbr(1,num_conti,i)=fprimcont*xj
3784 gacont_hbr(2,num_conti,i)=fprimcont*yj
3785 gacont_hbr(3,num_conti,i)=fprimcont*zj
3788 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3789 c following the change of gradient-summation algorithm.
3791 cgrad ghalfp=0.5D0*gggp(k)
3792 cgrad ghalfm=0.5D0*gggm(k)
3793 gacontp_hb1(k,num_conti,i)=!ghalfp
3794 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3795 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3796 gacontp_hb2(k,num_conti,i)=!ghalfp
3797 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3798 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3799 gacontp_hb3(k,num_conti,i)=gggp(k)
3800 gacontm_hb1(k,num_conti,i)=!ghalfm
3801 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3802 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3803 gacontm_hb2(k,num_conti,i)=!ghalfm
3804 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3805 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3806 gacontm_hb3(k,num_conti,i)=gggm(k)
3808 C Diagnostics. Comment out or remove after debugging!
3810 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3811 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3812 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3813 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3814 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3815 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3818 endif ! num_conti.le.maxconts
3821 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3824 ghalf=0.5d0*agg(l,k)
3825 aggi(l,k)=aggi(l,k)+ghalf
3826 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3827 aggj(l,k)=aggj(l,k)+ghalf
3830 if (j.eq.nres-1 .and. i.lt.j-2) then
3833 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3838 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3841 C-----------------------------------------------------------------------------
3842 subroutine eturn3(i,eello_turn3)
3843 C Third- and fourth-order contributions from turns
3844 implicit real*8 (a-h,o-z)
3845 include 'DIMENSIONS'
3846 include 'COMMON.IOUNITS'
3847 include 'COMMON.GEO'
3848 include 'COMMON.VAR'
3849 include 'COMMON.LOCAL'
3850 include 'COMMON.CHAIN'
3851 include 'COMMON.DERIV'
3852 include 'COMMON.INTERACT'
3853 include 'COMMON.CONTACTS'
3854 include 'COMMON.TORSION'
3855 include 'COMMON.VECTORS'
3856 include 'COMMON.FFIELD'
3857 include 'COMMON.CONTROL'
3859 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3860 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3861 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3862 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3863 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3864 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3865 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3868 c write (iout,*) "eturn3",i,j,j1,j2
3873 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3875 C Third-order contributions
3882 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3883 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3884 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3885 call transpose2(auxmat(1,1),auxmat1(1,1))
3886 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3887 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3888 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3889 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3890 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3891 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3892 cd & ' eello_turn3_num',4*eello_turn3_num
3893 C Derivatives in gamma(i)
3894 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3895 call transpose2(auxmat2(1,1),auxmat3(1,1))
3896 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3897 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3898 C Derivatives in gamma(i+1)
3899 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3900 call transpose2(auxmat2(1,1),auxmat3(1,1))
3901 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3902 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3903 & +0.5d0*(pizda(1,1)+pizda(2,2))
3904 C Cartesian derivatives
3906 c ghalf1=0.5d0*agg(l,1)
3907 c ghalf2=0.5d0*agg(l,2)
3908 c ghalf3=0.5d0*agg(l,3)
3909 c ghalf4=0.5d0*agg(l,4)
3910 a_temp(1,1)=aggi(l,1)!+ghalf1
3911 a_temp(1,2)=aggi(l,2)!+ghalf2
3912 a_temp(2,1)=aggi(l,3)!+ghalf3
3913 a_temp(2,2)=aggi(l,4)!+ghalf4
3914 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3915 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3916 & +0.5d0*(pizda(1,1)+pizda(2,2))
3917 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3918 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3919 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3920 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3921 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3922 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3923 & +0.5d0*(pizda(1,1)+pizda(2,2))
3924 a_temp(1,1)=aggj(l,1)!+ghalf1
3925 a_temp(1,2)=aggj(l,2)!+ghalf2
3926 a_temp(2,1)=aggj(l,3)!+ghalf3
3927 a_temp(2,2)=aggj(l,4)!+ghalf4
3928 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3929 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3930 & +0.5d0*(pizda(1,1)+pizda(2,2))
3931 a_temp(1,1)=aggj1(l,1)
3932 a_temp(1,2)=aggj1(l,2)
3933 a_temp(2,1)=aggj1(l,3)
3934 a_temp(2,2)=aggj1(l,4)
3935 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3936 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3937 & +0.5d0*(pizda(1,1)+pizda(2,2))
3941 C-------------------------------------------------------------------------------
3942 subroutine eturn4(i,eello_turn4)
3943 C Third- and fourth-order contributions from turns
3944 implicit real*8 (a-h,o-z)
3945 include 'DIMENSIONS'
3946 include 'COMMON.IOUNITS'
3947 include 'COMMON.GEO'
3948 include 'COMMON.VAR'
3949 include 'COMMON.LOCAL'
3950 include 'COMMON.CHAIN'
3951 include 'COMMON.DERIV'
3952 include 'COMMON.INTERACT'
3953 include 'COMMON.CONTACTS'
3954 include 'COMMON.TORSION'
3955 include 'COMMON.VECTORS'
3956 include 'COMMON.FFIELD'
3957 include 'COMMON.CONTROL'
3959 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3960 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3961 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3962 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3963 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3964 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3965 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3968 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3970 C Fourth-order contributions
3978 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3979 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3980 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3985 iti1=itortyp(itype(i+1))
3986 iti2=itortyp(itype(i+2))
3987 iti3=itortyp(itype(i+3))
3988 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3989 call transpose2(EUg(1,1,i+1),e1t(1,1))
3990 call transpose2(Eug(1,1,i+2),e2t(1,1))
3991 call transpose2(Eug(1,1,i+3),e3t(1,1))
3992 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3993 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3994 s1=scalar2(b1(1,iti2),auxvec(1))
3995 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3996 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3997 s2=scalar2(b1(1,iti1),auxvec(1))
3998 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3999 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4000 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4001 eello_turn4=eello_turn4-(s1+s2+s3)
4002 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4003 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4004 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4005 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4006 cd & ' eello_turn4_num',8*eello_turn4_num
4007 C Derivatives in gamma(i)
4008 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4009 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4010 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4011 s1=scalar2(b1(1,iti2),auxvec(1))
4012 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4013 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4014 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4015 C Derivatives in gamma(i+1)
4016 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4017 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4018 s2=scalar2(b1(1,iti1),auxvec(1))
4019 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4020 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4021 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4022 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4023 C Derivatives in gamma(i+2)
4024 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4025 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4026 s1=scalar2(b1(1,iti2),auxvec(1))
4027 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4028 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4029 s2=scalar2(b1(1,iti1),auxvec(1))
4030 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4031 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4032 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4033 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4034 C Cartesian derivatives
4035 C Derivatives of this turn contributions in DC(i+2)
4036 if (j.lt.nres-1) then
4038 a_temp(1,1)=agg(l,1)
4039 a_temp(1,2)=agg(l,2)
4040 a_temp(2,1)=agg(l,3)
4041 a_temp(2,2)=agg(l,4)
4042 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4043 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4044 s1=scalar2(b1(1,iti2),auxvec(1))
4045 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4046 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4047 s2=scalar2(b1(1,iti1),auxvec(1))
4048 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4049 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4050 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4052 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4055 C Remaining derivatives of this turn contribution
4057 a_temp(1,1)=aggi(l,1)
4058 a_temp(1,2)=aggi(l,2)
4059 a_temp(2,1)=aggi(l,3)
4060 a_temp(2,2)=aggi(l,4)
4061 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4062 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4063 s1=scalar2(b1(1,iti2),auxvec(1))
4064 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4065 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4066 s2=scalar2(b1(1,iti1),auxvec(1))
4067 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4068 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4069 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4070 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4071 a_temp(1,1)=aggi1(l,1)
4072 a_temp(1,2)=aggi1(l,2)
4073 a_temp(2,1)=aggi1(l,3)
4074 a_temp(2,2)=aggi1(l,4)
4075 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4076 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4077 s1=scalar2(b1(1,iti2),auxvec(1))
4078 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4079 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4080 s2=scalar2(b1(1,iti1),auxvec(1))
4081 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4082 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4083 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4084 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4085 a_temp(1,1)=aggj(l,1)
4086 a_temp(1,2)=aggj(l,2)
4087 a_temp(2,1)=aggj(l,3)
4088 a_temp(2,2)=aggj(l,4)
4089 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4090 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4091 s1=scalar2(b1(1,iti2),auxvec(1))
4092 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4093 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4094 s2=scalar2(b1(1,iti1),auxvec(1))
4095 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4096 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4097 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4098 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4099 a_temp(1,1)=aggj1(l,1)
4100 a_temp(1,2)=aggj1(l,2)
4101 a_temp(2,1)=aggj1(l,3)
4102 a_temp(2,2)=aggj1(l,4)
4103 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4104 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4105 s1=scalar2(b1(1,iti2),auxvec(1))
4106 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4107 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4108 s2=scalar2(b1(1,iti1),auxvec(1))
4109 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4110 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4111 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4112 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4113 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4117 C-----------------------------------------------------------------------------
4118 subroutine vecpr(u,v,w)
4119 implicit real*8(a-h,o-z)
4120 dimension u(3),v(3),w(3)
4121 w(1)=u(2)*v(3)-u(3)*v(2)
4122 w(2)=-u(1)*v(3)+u(3)*v(1)
4123 w(3)=u(1)*v(2)-u(2)*v(1)
4126 C-----------------------------------------------------------------------------
4127 subroutine unormderiv(u,ugrad,unorm,ungrad)
4128 C This subroutine computes the derivatives of a normalized vector u, given
4129 C the derivatives computed without normalization conditions, ugrad. Returns
4132 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4133 double precision vec(3)
4134 double precision scalar
4136 c write (2,*) 'ugrad',ugrad
4139 vec(i)=scalar(ugrad(1,i),u(1))
4141 c write (2,*) 'vec',vec
4144 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4147 c write (2,*) 'ungrad',ungrad
4150 C-----------------------------------------------------------------------------
4151 subroutine escp_soft_sphere(evdw2,evdw2_14)
4153 C This subroutine calculates the excluded-volume interaction energy between
4154 C peptide-group centers and side chains and its gradient in virtual-bond and
4155 C side-chain vectors.
4157 implicit real*8 (a-h,o-z)
4158 include 'DIMENSIONS'
4159 include 'COMMON.GEO'
4160 include 'COMMON.VAR'
4161 include 'COMMON.LOCAL'
4162 include 'COMMON.CHAIN'
4163 include 'COMMON.DERIV'
4164 include 'COMMON.INTERACT'
4165 include 'COMMON.FFIELD'
4166 include 'COMMON.IOUNITS'
4167 include 'COMMON.CONTROL'
4172 cd print '(a)','Enter ESCP'
4173 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4177 do i=iatscp_s,iatscp_e
4178 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4180 xi=0.5D0*(c(1,i)+c(1,i+1))
4181 yi=0.5D0*(c(2,i)+c(2,i+1))
4182 zi=0.5D0*(c(3,i)+c(3,i+1))
4183 C Return atom into box, boxxsize is size of box in x dimension
4185 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4186 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4187 C Condition for being inside the proper box
4188 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4189 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4193 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4194 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4195 C Condition for being inside the proper box
4196 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4197 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4201 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4202 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4203 cC Condition for being inside the proper box
4204 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4205 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4209 if (xi.lt.0) xi=xi+boxxsize
4211 if (yi.lt.0) yi=yi+boxysize
4213 if (zi.lt.0) zi=zi+boxzsize
4214 C xi=xi+xshift*boxxsize
4215 C yi=yi+yshift*boxysize
4216 C zi=zi+zshift*boxzsize
4217 do iint=1,nscp_gr(i)
4219 do j=iscpstart(i,iint),iscpend(i,iint)
4220 if (itype(j).eq.ntyp1) cycle
4221 itypj=iabs(itype(j))
4222 C Uncomment following three lines for SC-p interactions
4226 C Uncomment following three lines for Ca-p interactions
4231 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4232 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4233 C Condition for being inside the proper box
4234 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4235 c & (xj.lt.((-0.5d0)*boxxsize))) then
4239 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4240 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4241 cC Condition for being inside the proper box
4242 c if ((yj.gt.((0.5d0)*boxysize)).or.
4243 c & (yj.lt.((-0.5d0)*boxysize))) then
4247 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4248 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4249 C Condition for being inside the proper box
4250 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4251 c & (zj.lt.((-0.5d0)*boxzsize))) then
4254 if (xj.lt.0) xj=xj+boxxsize
4256 if (yj.lt.0) yj=yj+boxysize
4258 if (zj.lt.0) zj=zj+boxzsize
4259 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4267 xj=xj_safe+xshift*boxxsize
4268 yj=yj_safe+yshift*boxysize
4269 zj=zj_safe+zshift*boxzsize
4270 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4271 if(dist_temp.lt.dist_init) then
4281 if (subchap.eq.1) then
4294 rij=xj*xj+yj*yj+zj*zj
4298 if (rij.lt.r0ijsq) then
4299 evdwij=0.25d0*(rij-r0ijsq)**2
4307 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4312 cgrad if (j.lt.i) then
4313 cd write (iout,*) 'j<i'
4314 C Uncomment following three lines for SC-p interactions
4316 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4319 cd write (iout,*) 'j>i'
4321 cgrad ggg(k)=-ggg(k)
4322 C Uncomment following line for SC-p interactions
4323 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4327 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4329 cgrad kstart=min0(i+1,j)
4330 cgrad kend=max0(i-1,j-1)
4331 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4332 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4333 cgrad do k=kstart,kend
4335 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4339 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4340 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4351 C-----------------------------------------------------------------------------
4352 subroutine escp(evdw2,evdw2_14)
4354 C This subroutine calculates the excluded-volume interaction energy between
4355 C peptide-group centers and side chains and its gradient in virtual-bond and
4356 C side-chain vectors.
4358 implicit real*8 (a-h,o-z)
4359 include 'DIMENSIONS'
4360 include 'COMMON.GEO'
4361 include 'COMMON.VAR'
4362 include 'COMMON.LOCAL'
4363 include 'COMMON.CHAIN'
4364 include 'COMMON.DERIV'
4365 include 'COMMON.INTERACT'
4366 include 'COMMON.FFIELD'
4367 include 'COMMON.IOUNITS'
4368 include 'COMMON.CONTROL'
4369 include 'COMMON.SPLITELE'
4373 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
4374 cd print '(a)','Enter ESCP'
4375 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4379 do i=iatscp_s,iatscp_e
4380 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4382 xi=0.5D0*(c(1,i)+c(1,i+1))
4383 yi=0.5D0*(c(2,i)+c(2,i+1))
4384 zi=0.5D0*(c(3,i)+c(3,i+1))
4386 if (xi.lt.0) xi=xi+boxxsize
4388 if (yi.lt.0) yi=yi+boxysize
4390 if (zi.lt.0) zi=zi+boxzsize
4391 c xi=xi+xshift*boxxsize
4392 c yi=yi+yshift*boxysize
4393 c zi=zi+zshift*boxzsize
4394 c print *,xi,yi,zi,'polozenie i'
4395 C Return atom into box, boxxsize is size of box in x dimension
4397 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4398 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4399 C Condition for being inside the proper box
4400 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4401 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4405 c print *,xi,boxxsize,"pierwszy"
4407 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4408 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4409 C Condition for being inside the proper box
4410 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4411 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4415 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4416 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4417 C Condition for being inside the proper box
4418 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4419 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4422 do iint=1,nscp_gr(i)
4424 do j=iscpstart(i,iint),iscpend(i,iint)
4425 itypj=iabs(itype(j))
4426 if (itypj.eq.ntyp1) cycle
4427 C Uncomment following three lines for SC-p interactions
4431 C Uncomment following three lines for Ca-p interactions
4436 if (xj.lt.0) xj=xj+boxxsize
4438 if (yj.lt.0) yj=yj+boxysize
4440 if (zj.lt.0) zj=zj+boxzsize
4442 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4443 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4444 C Condition for being inside the proper box
4445 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4446 c & (xj.lt.((-0.5d0)*boxxsize))) then
4450 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4451 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4452 cC Condition for being inside the proper box
4453 c if ((yj.gt.((0.5d0)*boxysize)).or.
4454 c & (yj.lt.((-0.5d0)*boxysize))) then
4458 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4459 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4460 C Condition for being inside the proper box
4461 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4462 c & (zj.lt.((-0.5d0)*boxzsize))) then
4465 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
4466 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4474 xj=xj_safe+xshift*boxxsize
4475 yj=yj_safe+yshift*boxysize
4476 zj=zj_safe+zshift*boxzsize
4477 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4478 if(dist_temp.lt.dist_init) then
4488 if (subchap.eq.1) then
4497 c print *,xj,yj,zj,'polozenie j'
4498 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4500 sss=sscale(1.0d0/(dsqrt(rrij)))
4501 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
4502 c if (sss.eq.0) print *,'czasem jest OK'
4503 if (sss.le.0.0d0) cycle
4504 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4506 e1=fac*fac*aad(itypj,iteli)
4507 e2=fac*bad(itypj,iteli)
4508 if (iabs(j-i) .le. 2) then
4511 evdw2_14=evdw2_14+(e1+e2)*sss
4514 evdw2=evdw2+evdwij*sss
4515 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4516 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4519 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4521 fac=-(evdwij+e1)*rrij*sss
4522 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4526 cgrad if (j.lt.i) then
4527 cd write (iout,*) 'j<i'
4528 C Uncomment following three lines for SC-p interactions
4530 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4533 cd write (iout,*) 'j>i'
4535 cgrad ggg(k)=-ggg(k)
4536 C Uncomment following line for SC-p interactions
4537 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4538 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4542 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4544 cgrad kstart=min0(i+1,j)
4545 cgrad kend=max0(i-1,j-1)
4546 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4547 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4548 cgrad do k=kstart,kend
4550 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4554 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4555 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4557 c endif !endif for sscale cutoff
4567 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4568 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4569 gradx_scp(j,i)=expon*gradx_scp(j,i)
4572 C******************************************************************************
4576 C To save time the factor EXPON has been extracted from ALL components
4577 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4580 C******************************************************************************
4583 C--------------------------------------------------------------------------
4584 subroutine edis(ehpb)
4586 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4588 implicit real*8 (a-h,o-z)
4589 include 'DIMENSIONS'
4590 include 'COMMON.SBRIDGE'
4591 include 'COMMON.CHAIN'
4592 include 'COMMON.DERIV'
4593 include 'COMMON.VAR'
4594 include 'COMMON.INTERACT'
4595 include 'COMMON.IOUNITS'
4598 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4599 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4600 if (link_end.eq.0) return
4601 do i=link_start,link_end
4602 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4603 C CA-CA distance used in regularization of structure.
4606 C iii and jjj point to the residues for which the distance is assigned.
4607 if (ii.gt.nres) then
4614 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4615 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4616 C distance and angle dependent SS bond potential.
4617 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4618 & iabs(itype(jjj)).eq.1) then
4619 call ssbond_ene(iii,jjj,eij)
4621 cd write (iout,*) "eij",eij
4623 C Calculate the distance between the two points and its difference from the
4627 C Get the force constant corresponding to this distance.
4629 C Calculate the contribution to energy.
4630 ehpb=ehpb+waga*rdis*rdis
4632 C Evaluate gradient.
4635 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4636 cd & ' waga=',waga,' fac=',fac
4638 ggg(j)=fac*(c(j,jj)-c(j,ii))
4640 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4641 C If this is a SC-SC distance, we need to calculate the contributions to the
4642 C Cartesian gradient in the SC vectors (ghpbx).
4645 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4646 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4649 cgrad do j=iii,jjj-1
4651 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4655 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4656 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4663 C--------------------------------------------------------------------------
4664 subroutine ssbond_ene(i,j,eij)
4666 C Calculate the distance and angle dependent SS-bond potential energy
4667 C using a free-energy function derived based on RHF/6-31G** ab initio
4668 C calculations of diethyl disulfide.
4670 C A. Liwo and U. Kozlowska, 11/24/03
4672 implicit real*8 (a-h,o-z)
4673 include 'DIMENSIONS'
4674 include 'COMMON.SBRIDGE'
4675 include 'COMMON.CHAIN'
4676 include 'COMMON.DERIV'
4677 include 'COMMON.LOCAL'
4678 include 'COMMON.INTERACT'
4679 include 'COMMON.VAR'
4680 include 'COMMON.IOUNITS'
4681 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4682 itypi=iabs(itype(i))
4686 dxi=dc_norm(1,nres+i)
4687 dyi=dc_norm(2,nres+i)
4688 dzi=dc_norm(3,nres+i)
4689 c dsci_inv=dsc_inv(itypi)
4690 dsci_inv=vbld_inv(nres+i)
4691 itypj=iabs(itype(j))
4692 c dscj_inv=dsc_inv(itypj)
4693 dscj_inv=vbld_inv(nres+j)
4697 dxj=dc_norm(1,nres+j)
4698 dyj=dc_norm(2,nres+j)
4699 dzj=dc_norm(3,nres+j)
4700 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4705 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4706 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4707 om12=dxi*dxj+dyi*dyj+dzi*dzj
4709 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4710 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4716 deltat12=om2-om1+2.0d0
4718 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4719 & +akct*deltad*deltat12
4720 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4721 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4722 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4723 c & " deltat12",deltat12," eij",eij
4724 ed=2*akcm*deltad+akct*deltat12
4726 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4727 eom1=-2*akth*deltat1-pom1-om2*pom2
4728 eom2= 2*akth*deltat2+pom1-om1*pom2
4731 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4732 ghpbx(k,i)=ghpbx(k,i)-ggk
4733 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4734 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4735 ghpbx(k,j)=ghpbx(k,j)+ggk
4736 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4737 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4738 ghpbc(k,i)=ghpbc(k,i)-ggk
4739 ghpbc(k,j)=ghpbc(k,j)+ggk
4742 C Calculate the components of the gradient in DC and X
4746 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4751 C--------------------------------------------------------------------------
4752 subroutine ebond(estr)
4754 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4756 implicit real*8 (a-h,o-z)
4757 include 'DIMENSIONS'
4758 include 'COMMON.LOCAL'
4759 include 'COMMON.GEO'
4760 include 'COMMON.INTERACT'
4761 include 'COMMON.DERIV'
4762 include 'COMMON.VAR'
4763 include 'COMMON.CHAIN'
4764 include 'COMMON.IOUNITS'
4765 include 'COMMON.NAMES'
4766 include 'COMMON.FFIELD'
4767 include 'COMMON.CONTROL'
4768 include 'COMMON.SETUP'
4769 double precision u(3),ud(3)
4772 do i=ibondp_start,ibondp_end
4773 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4774 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4776 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4777 c & *dc(j,i-1)/vbld(i)
4779 c if (energy_dec) write(iout,*)
4780 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4782 C Checking if it involves dummy (NH3+ or COO-) group
4783 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4784 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
4785 diff = vbld(i)-vbldpDUM
4787 C NO vbldp0 is the equlibrium lenght of spring for peptide group
4788 diff = vbld(i)-vbldp0
4790 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
4791 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4794 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4796 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4799 estr=0.5d0*AKP*estr+estr1
4801 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4803 do i=ibond_start,ibond_end
4805 if (iti.ne.10 .and. iti.ne.ntyp1) then
4808 diff=vbld(i+nres)-vbldsc0(1,iti)
4809 if (energy_dec) write (iout,*)
4810 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4811 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4812 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4814 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4818 diff=vbld(i+nres)-vbldsc0(j,iti)
4819 ud(j)=aksc(j,iti)*diff
4820 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4834 uprod2=uprod2*u(k)*u(k)
4838 usumsqder=usumsqder+ud(j)*uprod2
4840 estr=estr+uprod/usum
4842 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4850 C--------------------------------------------------------------------------
4851 subroutine ebend(etheta)
4853 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4854 C angles gamma and its derivatives in consecutive thetas and gammas.
4856 implicit real*8 (a-h,o-z)
4857 include 'DIMENSIONS'
4858 include 'COMMON.LOCAL'
4859 include 'COMMON.GEO'
4860 include 'COMMON.INTERACT'
4861 include 'COMMON.DERIV'
4862 include 'COMMON.VAR'
4863 include 'COMMON.CHAIN'
4864 include 'COMMON.IOUNITS'
4865 include 'COMMON.NAMES'
4866 include 'COMMON.FFIELD'
4867 include 'COMMON.CONTROL'
4868 common /calcthet/ term1,term2,termm,diffak,ratak,
4869 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4870 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4871 double precision y(2),z(2)
4873 c time11=dexp(-2*time)
4876 c write (*,'(a,i2)') 'EBEND ICG=',icg
4877 do i=ithet_start,ithet_end
4878 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4879 & .or.itype(i).eq.ntyp1) cycle
4880 C Zero the energy function and its derivative at 0 or pi.
4881 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4883 ichir1=isign(1,itype(i-2))
4884 ichir2=isign(1,itype(i))
4885 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4886 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4887 if (itype(i-1).eq.10) then
4888 itype1=isign(10,itype(i-2))
4889 ichir11=isign(1,itype(i-2))
4890 ichir12=isign(1,itype(i-2))
4891 itype2=isign(10,itype(i))
4892 ichir21=isign(1,itype(i))
4893 ichir22=isign(1,itype(i))
4896 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4899 if (phii.ne.phii) phii=150.0
4909 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4912 if (phii1.ne.phii1) phii1=150.0
4924 C Calculate the "mean" value of theta from the part of the distribution
4925 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4926 C In following comments this theta will be referred to as t_c.
4927 thet_pred_mean=0.0d0
4929 athetk=athet(k,it,ichir1,ichir2)
4930 bthetk=bthet(k,it,ichir1,ichir2)
4932 athetk=athet(k,itype1,ichir11,ichir12)
4933 bthetk=bthet(k,itype2,ichir21,ichir22)
4935 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4936 c write(iout,*) 'chuj tu', y(k),z(k)
4938 dthett=thet_pred_mean*ssd
4939 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4940 C Derivatives of the "mean" values in gamma1 and gamma2.
4941 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4942 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4943 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4944 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4946 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4947 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4948 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4949 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4951 if (theta(i).gt.pi-delta) then
4952 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4954 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4955 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4956 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4958 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4960 else if (theta(i).lt.delta) then
4961 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4962 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4963 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4965 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4966 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4969 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4972 etheta=etheta+ethetai
4973 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4974 & 'ebend',i,ethetai,theta(i),itype(i)
4975 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4976 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4977 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
4979 C Ufff.... We've done all this!!!
4982 C---------------------------------------------------------------------------
4983 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4985 implicit real*8 (a-h,o-z)
4986 include 'DIMENSIONS'
4987 include 'COMMON.LOCAL'
4988 include 'COMMON.IOUNITS'
4989 common /calcthet/ term1,term2,termm,diffak,ratak,
4990 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4991 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4992 C Calculate the contributions to both Gaussian lobes.
4993 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4994 C The "polynomial part" of the "standard deviation" of this part of
4995 C the distributioni.
4996 ccc write (iout,*) thetai,thet_pred_mean
4999 sig=sig*thet_pred_mean+polthet(j,it)
5001 C Derivative of the "interior part" of the "standard deviation of the"
5002 C gamma-dependent Gaussian lobe in t_c.
5003 sigtc=3*polthet(3,it)
5005 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5008 C Set the parameters of both Gaussian lobes of the distribution.
5009 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5010 fac=sig*sig+sigc0(it)
5013 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5014 sigsqtc=-4.0D0*sigcsq*sigtc
5015 c print *,i,sig,sigtc,sigsqtc
5016 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5017 sigtc=-sigtc/(fac*fac)
5018 C Following variable is sigma(t_c)**(-2)
5019 sigcsq=sigcsq*sigcsq
5021 sig0inv=1.0D0/sig0i**2
5022 delthec=thetai-thet_pred_mean
5023 delthe0=thetai-theta0i
5024 term1=-0.5D0*sigcsq*delthec*delthec
5025 term2=-0.5D0*sig0inv*delthe0*delthe0
5026 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5027 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5028 C NaNs in taking the logarithm. We extract the largest exponent which is added
5029 C to the energy (this being the log of the distribution) at the end of energy
5030 C term evaluation for this virtual-bond angle.
5031 if (term1.gt.term2) then
5033 term2=dexp(term2-termm)
5037 term1=dexp(term1-termm)
5040 C The ratio between the gamma-independent and gamma-dependent lobes of
5041 C the distribution is a Gaussian function of thet_pred_mean too.
5042 diffak=gthet(2,it)-thet_pred_mean
5043 ratak=diffak/gthet(3,it)**2
5044 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5045 C Let's differentiate it in thet_pred_mean NOW.
5047 C Now put together the distribution terms to make complete distribution.
5048 termexp=term1+ak*term2
5049 termpre=sigc+ak*sig0i
5050 C Contribution of the bending energy from this theta is just the -log of
5051 C the sum of the contributions from the two lobes and the pre-exponential
5052 C factor. Simple enough, isn't it?
5053 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5054 C write (iout,*) 'termexp',termexp,termm,termpre,i
5055 C NOW the derivatives!!!
5056 C 6/6/97 Take into account the deformation.
5057 E_theta=(delthec*sigcsq*term1
5058 & +ak*delthe0*sig0inv*term2)/termexp
5059 E_tc=((sigtc+aktc*sig0i)/termpre
5060 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5061 & aktc*term2)/termexp)
5064 c-----------------------------------------------------------------------------
5065 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5066 implicit real*8 (a-h,o-z)
5067 include 'DIMENSIONS'
5068 include 'COMMON.LOCAL'
5069 include 'COMMON.IOUNITS'
5070 common /calcthet/ term1,term2,termm,diffak,ratak,
5071 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5072 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5073 delthec=thetai-thet_pred_mean
5074 delthe0=thetai-theta0i
5075 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5076 t3 = thetai-thet_pred_mean
5080 t14 = t12+t6*sigsqtc
5082 t21 = thetai-theta0i
5088 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5089 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5090 & *(-t12*t9-ak*sig0inv*t27)
5094 C--------------------------------------------------------------------------
5095 subroutine ebend(etheta)
5097 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5098 C angles gamma and its derivatives in consecutive thetas and gammas.
5099 C ab initio-derived potentials from
5100 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5102 implicit real*8 (a-h,o-z)
5103 include 'DIMENSIONS'
5104 include 'COMMON.LOCAL'
5105 include 'COMMON.GEO'
5106 include 'COMMON.INTERACT'
5107 include 'COMMON.DERIV'
5108 include 'COMMON.VAR'
5109 include 'COMMON.CHAIN'
5110 include 'COMMON.IOUNITS'
5111 include 'COMMON.NAMES'
5112 include 'COMMON.FFIELD'
5113 include 'COMMON.CONTROL'
5114 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5115 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5116 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5117 & sinph1ph2(maxdouble,maxdouble)
5118 logical lprn /.false./, lprn1 /.false./
5120 do i=ithet_start,ithet_end
5121 c print *,i,itype(i-1),itype(i),itype(i-2)
5122 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5123 & .or.itype(i).eq.ntyp1) cycle
5124 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
5126 if (iabs(itype(i+1)).eq.20) iblock=2
5127 if (iabs(itype(i+1)).ne.20) iblock=1
5131 theti2=0.5d0*theta(i)
5132 ityp2=ithetyp((itype(i-1)))
5134 coskt(k)=dcos(k*theti2)
5135 sinkt(k)=dsin(k*theti2)
5137 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5140 if (phii.ne.phii) phii=150.0
5144 ityp1=ithetyp((itype(i-2)))
5145 C propagation of chirality for glycine type
5147 cosph1(k)=dcos(k*phii)
5148 sinph1(k)=dsin(k*phii)
5158 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5161 if (phii1.ne.phii1) phii1=150.0
5166 ityp3=ithetyp((itype(i)))
5168 cosph2(k)=dcos(k*phii1)
5169 sinph2(k)=dsin(k*phii1)
5179 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5182 ccl=cosph1(l)*cosph2(k-l)
5183 ssl=sinph1(l)*sinph2(k-l)
5184 scl=sinph1(l)*cosph2(k-l)
5185 csl=cosph1(l)*sinph2(k-l)
5186 cosph1ph2(l,k)=ccl-ssl
5187 cosph1ph2(k,l)=ccl+ssl
5188 sinph1ph2(l,k)=scl+csl
5189 sinph1ph2(k,l)=scl-csl
5193 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5194 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5195 write (iout,*) "coskt and sinkt"
5197 write (iout,*) k,coskt(k),sinkt(k)
5201 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5202 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5205 & write (iout,*) "k",k,"
5206 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5207 & " ethetai",ethetai
5210 write (iout,*) "cosph and sinph"
5212 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5214 write (iout,*) "cosph1ph2 and sinph2ph2"
5217 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5218 & sinph1ph2(l,k),sinph1ph2(k,l)
5221 write(iout,*) "ethetai",ethetai
5225 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5226 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5227 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5228 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5229 ethetai=ethetai+sinkt(m)*aux
5230 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5231 dephii=dephii+k*sinkt(m)*(
5232 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5233 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5234 dephii1=dephii1+k*sinkt(m)*(
5235 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5236 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5238 & write (iout,*) "m",m," k",k," bbthet",
5239 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5240 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5241 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5242 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5246 & write(iout,*) "ethetai",ethetai
5250 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5251 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5252 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5253 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5254 ethetai=ethetai+sinkt(m)*aux
5255 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5256 dephii=dephii+l*sinkt(m)*(
5257 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5258 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5259 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5260 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5261 dephii1=dephii1+(k-l)*sinkt(m)*(
5262 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5263 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5264 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5265 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5267 write (iout,*) "m",m," k",k," l",l," ffthet",
5268 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5269 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5270 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5271 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5272 & " ethetai",ethetai
5273 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5274 & cosph1ph2(k,l)*sinkt(m),
5275 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5283 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5284 & i,theta(i)*rad2deg,phii*rad2deg,
5285 & phii1*rad2deg,ethetai
5287 etheta=etheta+ethetai
5288 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5289 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5290 gloc(nphi+i-2,icg)=wang*dethetai+ gloc(nphi+i-2,icg)
5296 c-----------------------------------------------------------------------------
5297 subroutine esc(escloc)
5298 C Calculate the local energy of a side chain and its derivatives in the
5299 C corresponding virtual-bond valence angles THETA and the spherical angles
5301 implicit real*8 (a-h,o-z)
5302 include 'DIMENSIONS'
5303 include 'COMMON.GEO'
5304 include 'COMMON.LOCAL'
5305 include 'COMMON.VAR'
5306 include 'COMMON.INTERACT'
5307 include 'COMMON.DERIV'
5308 include 'COMMON.CHAIN'
5309 include 'COMMON.IOUNITS'
5310 include 'COMMON.NAMES'
5311 include 'COMMON.FFIELD'
5312 include 'COMMON.CONTROL'
5313 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5314 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5315 common /sccalc/ time11,time12,time112,theti,it,nlobit
5318 c write (iout,'(a)') 'ESC'
5319 do i=loc_start,loc_end
5321 if (it.eq.ntyp1) cycle
5322 if (it.eq.10) goto 1
5323 nlobit=nlob(iabs(it))
5324 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5325 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5326 theti=theta(i+1)-pipol
5331 if (x(2).gt.pi-delta) then
5335 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5337 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5338 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5340 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5341 & ddersc0(1),dersc(1))
5342 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5343 & ddersc0(3),dersc(3))
5345 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5347 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5348 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5349 & dersc0(2),esclocbi,dersc02)
5350 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5352 call splinthet(x(2),0.5d0*delta,ss,ssd)
5357 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5359 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5360 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5362 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5364 c write (iout,*) escloci
5365 else if (x(2).lt.delta) then
5369 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5371 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5372 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5374 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5375 & ddersc0(1),dersc(1))
5376 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5377 & ddersc0(3),dersc(3))
5379 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5381 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5382 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5383 & dersc0(2),esclocbi,dersc02)
5384 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5389 call splinthet(x(2),0.5d0*delta,ss,ssd)
5391 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5393 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5394 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5396 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5397 c write (iout,*) escloci
5399 call enesc(x,escloci,dersc,ddummy,.false.)
5402 escloc=escloc+escloci
5403 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5404 & 'escloc',i,escloci
5405 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5407 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5409 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5410 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5415 C---------------------------------------------------------------------------
5416 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5417 implicit real*8 (a-h,o-z)
5418 include 'DIMENSIONS'
5419 include 'COMMON.GEO'
5420 include 'COMMON.LOCAL'
5421 include 'COMMON.IOUNITS'
5422 common /sccalc/ time11,time12,time112,theti,it,nlobit
5423 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5424 double precision contr(maxlob,-1:1)
5426 c write (iout,*) 'it=',it,' nlobit=',nlobit
5430 if (mixed) ddersc(j)=0.0d0
5434 C Because of periodicity of the dependence of the SC energy in omega we have
5435 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5436 C To avoid underflows, first compute & store the exponents.
5444 z(k)=x(k)-censc(k,j,it)
5449 Axk=Axk+gaussc(l,k,j,it)*z(l)
5455 expfac=expfac+Ax(k,j,iii)*z(k)
5463 C As in the case of ebend, we want to avoid underflows in exponentiation and
5464 C subsequent NaNs and INFs in energy calculation.
5465 C Find the largest exponent
5469 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5473 cd print *,'it=',it,' emin=',emin
5475 C Compute the contribution to SC energy and derivatives
5480 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5481 if(adexp.ne.adexp) adexp=1.0
5484 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5486 cd print *,'j=',j,' expfac=',expfac
5487 escloc_i=escloc_i+expfac
5489 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5493 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5494 & +gaussc(k,2,j,it))*expfac
5501 dersc(1)=dersc(1)/cos(theti)**2
5502 ddersc(1)=ddersc(1)/cos(theti)**2
5505 escloci=-(dlog(escloc_i)-emin)
5507 dersc(j)=dersc(j)/escloc_i
5511 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5516 C------------------------------------------------------------------------------
5517 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5518 implicit real*8 (a-h,o-z)
5519 include 'DIMENSIONS'
5520 include 'COMMON.GEO'
5521 include 'COMMON.LOCAL'
5522 include 'COMMON.IOUNITS'
5523 common /sccalc/ time11,time12,time112,theti,it,nlobit
5524 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5525 double precision contr(maxlob)
5536 z(k)=x(k)-censc(k,j,it)
5542 Axk=Axk+gaussc(l,k,j,it)*z(l)
5548 expfac=expfac+Ax(k,j)*z(k)
5553 C As in the case of ebend, we want to avoid underflows in exponentiation and
5554 C subsequent NaNs and INFs in energy calculation.
5555 C Find the largest exponent
5558 if (emin.gt.contr(j)) emin=contr(j)
5562 C Compute the contribution to SC energy and derivatives
5566 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5567 escloc_i=escloc_i+expfac
5569 dersc(k)=dersc(k)+Ax(k,j)*expfac
5571 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5572 & +gaussc(1,2,j,it))*expfac
5576 dersc(1)=dersc(1)/cos(theti)**2
5577 dersc12=dersc12/cos(theti)**2
5578 escloci=-(dlog(escloc_i)-emin)
5580 dersc(j)=dersc(j)/escloc_i
5582 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5586 c----------------------------------------------------------------------------------
5587 subroutine esc(escloc)
5588 C Calculate the local energy of a side chain and its derivatives in the
5589 C corresponding virtual-bond valence angles THETA and the spherical angles
5590 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5591 C added by Urszula Kozlowska. 07/11/2007
5593 implicit real*8 (a-h,o-z)
5594 include 'DIMENSIONS'
5595 include 'COMMON.GEO'
5596 include 'COMMON.LOCAL'
5597 include 'COMMON.VAR'
5598 include 'COMMON.SCROT'
5599 include 'COMMON.INTERACT'
5600 include 'COMMON.DERIV'
5601 include 'COMMON.CHAIN'
5602 include 'COMMON.IOUNITS'
5603 include 'COMMON.NAMES'
5604 include 'COMMON.FFIELD'
5605 include 'COMMON.CONTROL'
5606 include 'COMMON.VECTORS'
5607 double precision x_prime(3),y_prime(3),z_prime(3)
5608 & , sumene,dsc_i,dp2_i,x(65),
5609 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5610 & de_dxx,de_dyy,de_dzz,de_dt
5611 double precision s1_t,s1_6_t,s2_t,s2_6_t
5613 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5614 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5615 & dt_dCi(3),dt_dCi1(3)
5616 common /sccalc/ time11,time12,time112,theti,it,nlobit
5619 do i=loc_start,loc_end
5620 if (itype(i).eq.ntyp1) cycle
5621 costtab(i+1) =dcos(theta(i+1))
5622 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5623 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5624 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5625 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5626 cosfac=dsqrt(cosfac2)
5627 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5628 sinfac=dsqrt(sinfac2)
5630 if (it.eq.10) goto 1
5632 C Compute the axes of tghe local cartesian coordinates system; store in
5633 c x_prime, y_prime and z_prime
5640 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5641 C & dc_norm(3,i+nres)
5643 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5644 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5647 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5650 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5651 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5652 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5653 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5654 c & " xy",scalar(x_prime(1),y_prime(1)),
5655 c & " xz",scalar(x_prime(1),z_prime(1)),
5656 c & " yy",scalar(y_prime(1),y_prime(1)),
5657 c & " yz",scalar(y_prime(1),z_prime(1)),
5658 c & " zz",scalar(z_prime(1),z_prime(1))
5660 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5661 C to local coordinate system. Store in xx, yy, zz.
5667 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5668 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5669 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5676 C Compute the energy of the ith side cbain
5678 c write (2,*) "xx",xx," yy",yy," zz",zz
5681 x(j) = sc_parmin(j,it)
5684 Cc diagnostics - remove later
5686 yy1 = dsin(alph(2))*dcos(omeg(2))
5687 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5688 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5689 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5691 C," --- ", xx_w,yy_w,zz_w
5694 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5695 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5697 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5698 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5700 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5701 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5702 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5703 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5704 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5706 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5707 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5708 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5709 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5710 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5712 dsc_i = 0.743d0+x(61)
5714 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5715 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5716 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5717 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5718 s1=(1+x(63))/(0.1d0 + dscp1)
5719 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5720 s2=(1+x(65))/(0.1d0 + dscp2)
5721 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5722 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5723 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5724 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5726 c & dscp1,dscp2,sumene
5727 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5728 escloc = escloc + sumene
5729 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5734 C This section to check the numerical derivatives of the energy of ith side
5735 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5736 C #define DEBUG in the code to turn it on.
5738 write (2,*) "sumene =",sumene
5742 write (2,*) xx,yy,zz
5743 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5744 de_dxx_num=(sumenep-sumene)/aincr
5746 write (2,*) "xx+ sumene from enesc=",sumenep
5749 write (2,*) xx,yy,zz
5750 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5751 de_dyy_num=(sumenep-sumene)/aincr
5753 write (2,*) "yy+ sumene from enesc=",sumenep
5756 write (2,*) xx,yy,zz
5757 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5758 de_dzz_num=(sumenep-sumene)/aincr
5760 write (2,*) "zz+ sumene from enesc=",sumenep
5761 costsave=cost2tab(i+1)
5762 sintsave=sint2tab(i+1)
5763 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5764 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5765 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5766 de_dt_num=(sumenep-sumene)/aincr
5767 write (2,*) " t+ sumene from enesc=",sumenep
5768 cost2tab(i+1)=costsave
5769 sint2tab(i+1)=sintsave
5770 C End of diagnostics section.
5773 C Compute the gradient of esc
5775 c zz=zz*dsign(1.0,dfloat(itype(i)))
5776 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5777 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5778 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5779 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5780 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5781 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5782 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5783 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5784 pom1=(sumene3*sint2tab(i+1)+sumene1)
5785 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5786 pom2=(sumene4*cost2tab(i+1)+sumene2)
5787 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5788 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5789 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5790 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5792 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5793 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5794 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5796 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5797 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5798 & +(pom1+pom2)*pom_dx
5800 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5803 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5804 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5805 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5807 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5808 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5809 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5810 & +x(59)*zz**2 +x(60)*xx*zz
5811 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5812 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5813 & +(pom1-pom2)*pom_dy
5815 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5818 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5819 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5820 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5821 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5822 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5823 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5824 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5825 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5827 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5830 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5831 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5832 & +pom1*pom_dt1+pom2*pom_dt2
5834 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5839 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5840 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5841 cosfac2xx=cosfac2*xx
5842 sinfac2yy=sinfac2*yy
5844 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5846 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5848 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5849 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5850 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5851 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5852 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5853 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5854 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5855 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5856 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5857 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5861 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5862 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5863 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5864 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5867 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5868 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5869 dZZ_XYZ(k)=vbld_inv(i+nres)*
5870 & (z_prime(k)-zz*dC_norm(k,i+nres))
5872 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5873 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5877 dXX_Ctab(k,i)=dXX_Ci(k)
5878 dXX_C1tab(k,i)=dXX_Ci1(k)
5879 dYY_Ctab(k,i)=dYY_Ci(k)
5880 dYY_C1tab(k,i)=dYY_Ci1(k)
5881 dZZ_Ctab(k,i)=dZZ_Ci(k)
5882 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5883 dXX_XYZtab(k,i)=dXX_XYZ(k)
5884 dYY_XYZtab(k,i)=dYY_XYZ(k)
5885 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5889 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5890 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5891 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5892 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5893 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5895 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5896 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5897 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5898 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5899 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5900 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5901 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5902 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5904 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5905 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5907 C to check gradient call subroutine check_grad
5913 c------------------------------------------------------------------------------
5914 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5916 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5917 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5918 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5919 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5921 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5922 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5924 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5925 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5926 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5927 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5928 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5930 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5931 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5932 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5933 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5934 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5936 dsc_i = 0.743d0+x(61)
5938 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5939 & *(xx*cost2+yy*sint2))
5940 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5941 & *(xx*cost2-yy*sint2))
5942 s1=(1+x(63))/(0.1d0 + dscp1)
5943 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5944 s2=(1+x(65))/(0.1d0 + dscp2)
5945 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5946 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5947 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5952 c------------------------------------------------------------------------------
5953 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5955 C This procedure calculates two-body contact function g(rij) and its derivative:
5958 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5961 C where x=(rij-r0ij)/delta
5963 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5966 double precision rij,r0ij,eps0ij,fcont,fprimcont
5967 double precision x,x2,x4,delta
5971 if (x.lt.-1.0D0) then
5974 else if (x.le.1.0D0) then
5977 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5978 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5985 c------------------------------------------------------------------------------
5986 subroutine splinthet(theti,delta,ss,ssder)
5987 implicit real*8 (a-h,o-z)
5988 include 'DIMENSIONS'
5989 include 'COMMON.VAR'
5990 include 'COMMON.GEO'
5993 if (theti.gt.pipol) then
5994 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5996 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6001 c------------------------------------------------------------------------------
6002 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6004 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6005 double precision ksi,ksi2,ksi3,a1,a2,a3
6006 a1=fprim0*delta/(f1-f0)
6012 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6013 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6016 c------------------------------------------------------------------------------
6017 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6019 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6020 double precision ksi,ksi2,ksi3,a1,a2,a3
6025 a2=3*(f1x-f0x)-2*fprim0x*delta
6026 a3=fprim0x*delta-2*(f1x-f0x)
6027 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6030 C-----------------------------------------------------------------------------
6032 C-----------------------------------------------------------------------------
6033 subroutine etor(etors,edihcnstr)
6034 implicit real*8 (a-h,o-z)
6035 include 'DIMENSIONS'
6036 include 'COMMON.VAR'
6037 include 'COMMON.GEO'
6038 include 'COMMON.LOCAL'
6039 include 'COMMON.TORSION'
6040 include 'COMMON.INTERACT'
6041 include 'COMMON.DERIV'
6042 include 'COMMON.CHAIN'
6043 include 'COMMON.NAMES'
6044 include 'COMMON.IOUNITS'
6045 include 'COMMON.FFIELD'
6046 include 'COMMON.TORCNSTR'
6047 include 'COMMON.CONTROL'
6049 C Set lprn=.true. for debugging
6053 do i=iphi_start,iphi_end
6055 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6056 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6057 itori=itortyp(itype(i-2))
6058 itori1=itortyp(itype(i-1))
6061 C Proline-Proline pair is a special case...
6062 if (itori.eq.3 .and. itori1.eq.3) then
6063 if (phii.gt.-dwapi3) then
6065 fac=1.0D0/(1.0D0-cosphi)
6066 etorsi=v1(1,3,3)*fac
6067 etorsi=etorsi+etorsi
6068 etors=etors+etorsi-v1(1,3,3)
6069 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6070 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6073 v1ij=v1(j+1,itori,itori1)
6074 v2ij=v2(j+1,itori,itori1)
6077 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6078 if (energy_dec) etors_ii=etors_ii+
6079 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6080 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6084 v1ij=v1(j,itori,itori1)
6085 v2ij=v2(j,itori,itori1)
6088 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6089 if (energy_dec) etors_ii=etors_ii+
6090 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6091 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6094 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6097 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6098 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6099 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6100 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6101 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6103 ! 6/20/98 - dihedral angle constraints
6106 itori=idih_constr(i)
6109 if (difi.gt.drange(i)) then
6111 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6112 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6113 else if (difi.lt.-drange(i)) then
6115 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6116 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6118 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6119 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6121 ! write (iout,*) 'edihcnstr',edihcnstr
6124 c------------------------------------------------------------------------------
6125 subroutine etor_d(etors_d)
6129 c----------------------------------------------------------------------------
6131 subroutine etor(etors,edihcnstr)
6132 implicit real*8 (a-h,o-z)
6133 include 'DIMENSIONS'
6134 include 'COMMON.VAR'
6135 include 'COMMON.GEO'
6136 include 'COMMON.LOCAL'
6137 include 'COMMON.TORSION'
6138 include 'COMMON.INTERACT'
6139 include 'COMMON.DERIV'
6140 include 'COMMON.CHAIN'
6141 include 'COMMON.NAMES'
6142 include 'COMMON.IOUNITS'
6143 include 'COMMON.FFIELD'
6144 include 'COMMON.TORCNSTR'
6145 include 'COMMON.CONTROL'
6147 C Set lprn=.true. for debugging
6151 do i=iphi_start,iphi_end
6152 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6153 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6154 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6155 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6156 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6157 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6158 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6159 C For introducing the NH3+ and COO- group please check the etor_d for reference
6162 if (iabs(itype(i)).eq.20) then
6167 itori=itortyp(itype(i-2))
6168 itori1=itortyp(itype(i-1))
6171 C Regular cosine and sine terms
6172 do j=1,nterm(itori,itori1,iblock)
6173 v1ij=v1(j,itori,itori1,iblock)
6174 v2ij=v2(j,itori,itori1,iblock)
6177 etors=etors+v1ij*cosphi+v2ij*sinphi
6178 if (energy_dec) etors_ii=etors_ii+
6179 & v1ij*cosphi+v2ij*sinphi
6180 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6184 C E = SUM ----------------------------------- - v1
6185 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6187 cosphi=dcos(0.5d0*phii)
6188 sinphi=dsin(0.5d0*phii)
6189 do j=1,nlor(itori,itori1,iblock)
6190 vl1ij=vlor1(j,itori,itori1)
6191 vl2ij=vlor2(j,itori,itori1)
6192 vl3ij=vlor3(j,itori,itori1)
6193 pom=vl2ij*cosphi+vl3ij*sinphi
6194 pom1=1.0d0/(pom*pom+1.0d0)
6195 etors=etors+vl1ij*pom1
6196 if (energy_dec) etors_ii=etors_ii+
6199 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6201 C Subtract the constant term
6202 etors=etors-v0(itori,itori1,iblock)
6203 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6204 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6206 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6207 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6208 & (v1(j,itori,itori1,iblock),j=1,6),
6209 & (v2(j,itori,itori1,iblock),j=1,6)
6210 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6211 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6213 ! 6/20/98 - dihedral angle constraints
6215 c do i=1,ndih_constr
6216 do i=idihconstr_start,idihconstr_end
6217 itori=idih_constr(i)
6219 difi=pinorm(phii-phi0(i))
6220 if (difi.gt.drange(i)) then
6222 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6223 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6224 else if (difi.lt.-drange(i)) then
6226 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6227 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6231 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6232 cd & rad2deg*phi0(i), rad2deg*drange(i),
6233 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6235 cd write (iout,*) 'edihcnstr',edihcnstr
6238 c----------------------------------------------------------------------------
6239 subroutine etor_d(etors_d)
6240 C 6/23/01 Compute double torsional energy
6241 implicit real*8 (a-h,o-z)
6242 include 'DIMENSIONS'
6243 include 'COMMON.VAR'
6244 include 'COMMON.GEO'
6245 include 'COMMON.LOCAL'
6246 include 'COMMON.TORSION'
6247 include 'COMMON.INTERACT'
6248 include 'COMMON.DERIV'
6249 include 'COMMON.CHAIN'
6250 include 'COMMON.NAMES'
6251 include 'COMMON.IOUNITS'
6252 include 'COMMON.FFIELD'
6253 include 'COMMON.TORCNSTR'
6255 C Set lprn=.true. for debugging
6259 c write(iout,*) "a tu??"
6260 do i=iphid_start,iphid_end
6261 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6262 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6263 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6264 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6265 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6266 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6267 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6268 & (itype(i+1).eq.ntyp1)) cycle
6269 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6270 itori=itortyp(itype(i-2))
6271 itori1=itortyp(itype(i-1))
6272 itori2=itortyp(itype(i))
6278 if (iabs(itype(i+1)).eq.20) iblock=2
6279 C Iblock=2 Proline type
6280 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6281 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6282 C if (itype(i+1).eq.ntyp1) iblock=3
6283 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6284 C IS or IS NOT need for this
6285 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6286 C is (itype(i-3).eq.ntyp1) ntblock=2
6287 C ntblock is N-terminal blocking group
6289 C Regular cosine and sine terms
6290 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6291 C Example of changes for NH3+ blocking group
6292 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6293 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6294 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6295 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6296 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6297 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6298 cosphi1=dcos(j*phii)
6299 sinphi1=dsin(j*phii)
6300 cosphi2=dcos(j*phii1)
6301 sinphi2=dsin(j*phii1)
6302 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6303 & v2cij*cosphi2+v2sij*sinphi2
6304 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6305 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6307 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6309 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6310 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6311 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6312 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6313 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6314 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6315 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6316 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6317 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6318 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6319 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6320 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6321 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6322 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6325 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6326 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6331 c------------------------------------------------------------------------------
6332 subroutine eback_sc_corr(esccor)
6333 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6334 c conformational states; temporarily implemented as differences
6335 c between UNRES torsional potentials (dependent on three types of
6336 c residues) and the torsional potentials dependent on all 20 types
6337 c of residues computed from AM1 energy surfaces of terminally-blocked
6338 c amino-acid residues.
6339 implicit real*8 (a-h,o-z)
6340 include 'DIMENSIONS'
6341 include 'COMMON.VAR'
6342 include 'COMMON.GEO'
6343 include 'COMMON.LOCAL'
6344 include 'COMMON.TORSION'
6345 include 'COMMON.SCCOR'
6346 include 'COMMON.INTERACT'
6347 include 'COMMON.DERIV'
6348 include 'COMMON.CHAIN'
6349 include 'COMMON.NAMES'
6350 include 'COMMON.IOUNITS'
6351 include 'COMMON.FFIELD'
6352 include 'COMMON.CONTROL'
6354 C Set lprn=.true. for debugging
6357 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6359 do i=itau_start,itau_end
6360 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6362 isccori=isccortyp(itype(i-2))
6363 isccori1=isccortyp(itype(i-1))
6364 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6366 do intertyp=1,3 !intertyp
6367 cc Added 09 May 2012 (Adasko)
6368 cc Intertyp means interaction type of backbone mainchain correlation:
6369 c 1 = SC...Ca...Ca...Ca
6370 c 2 = Ca...Ca...Ca...SC
6371 c 3 = SC...Ca...Ca...SCi
6373 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6374 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6375 & (itype(i-1).eq.ntyp1)))
6376 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6377 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6378 & .or.(itype(i).eq.ntyp1)))
6379 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6380 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6381 & (itype(i-3).eq.ntyp1)))) cycle
6382 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6383 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6385 do j=1,nterm_sccor(isccori,isccori1)
6386 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6387 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6388 cosphi=dcos(j*tauangle(intertyp,i))
6389 sinphi=dsin(j*tauangle(intertyp,i))
6390 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6391 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6393 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6394 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6396 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6397 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6398 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6399 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6400 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6406 c----------------------------------------------------------------------------
6407 subroutine multibody(ecorr)
6408 C This subroutine calculates multi-body contributions to energy following
6409 C the idea of Skolnick et al. If side chains I and J make a contact and
6410 C at the same time side chains I+1 and J+1 make a contact, an extra
6411 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6412 implicit real*8 (a-h,o-z)
6413 include 'DIMENSIONS'
6414 include 'COMMON.IOUNITS'
6415 include 'COMMON.DERIV'
6416 include 'COMMON.INTERACT'
6417 include 'COMMON.CONTACTS'
6418 double precision gx(3),gx1(3)
6421 C Set lprn=.true. for debugging
6425 write (iout,'(a)') 'Contact function values:'
6427 write (iout,'(i2,20(1x,i2,f10.5))')
6428 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6443 num_conti=num_cont(i)
6444 num_conti1=num_cont(i1)
6449 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6450 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6451 cd & ' ishift=',ishift
6452 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6453 C The system gains extra energy.
6454 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6455 endif ! j1==j+-ishift
6464 c------------------------------------------------------------------------------
6465 double precision function esccorr(i,j,k,l,jj,kk)
6466 implicit real*8 (a-h,o-z)
6467 include 'DIMENSIONS'
6468 include 'COMMON.IOUNITS'
6469 include 'COMMON.DERIV'
6470 include 'COMMON.INTERACT'
6471 include 'COMMON.CONTACTS'
6472 double precision gx(3),gx1(3)
6477 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6478 C Calculate the multi-body contribution to energy.
6479 C Calculate multi-body contributions to the gradient.
6480 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6481 cd & k,l,(gacont(m,kk,k),m=1,3)
6483 gx(m) =ekl*gacont(m,jj,i)
6484 gx1(m)=eij*gacont(m,kk,k)
6485 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6486 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6487 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6488 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6492 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6497 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6503 c------------------------------------------------------------------------------
6504 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6505 C This subroutine calculates multi-body contributions to hydrogen-bonding
6506 implicit real*8 (a-h,o-z)
6507 include 'DIMENSIONS'
6508 include 'COMMON.IOUNITS'
6511 parameter (max_cont=maxconts)
6512 parameter (max_dim=26)
6513 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6514 double precision zapas(max_dim,maxconts,max_fg_procs),
6515 & zapas_recv(max_dim,maxconts,max_fg_procs)
6516 common /przechowalnia/ zapas
6517 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6518 & status_array(MPI_STATUS_SIZE,maxconts*2)
6520 include 'COMMON.SETUP'
6521 include 'COMMON.FFIELD'
6522 include 'COMMON.DERIV'
6523 include 'COMMON.INTERACT'
6524 include 'COMMON.CONTACTS'
6525 include 'COMMON.CONTROL'
6526 include 'COMMON.LOCAL'
6527 double precision gx(3),gx1(3),time00
6530 C Set lprn=.true. for debugging
6535 if (nfgtasks.le.1) goto 30
6537 write (iout,'(a)') 'Contact function values before RECEIVE:'
6539 write (iout,'(2i3,50(1x,i2,f5.2))')
6540 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6541 & j=1,num_cont_hb(i))
6545 do i=1,ntask_cont_from
6548 do i=1,ntask_cont_to
6551 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6553 C Make the list of contacts to send to send to other procesors
6554 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6556 do i=iturn3_start,iturn3_end
6557 c write (iout,*) "make contact list turn3",i," num_cont",
6559 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6561 do i=iturn4_start,iturn4_end
6562 c write (iout,*) "make contact list turn4",i," num_cont",
6564 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6568 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6570 do j=1,num_cont_hb(i)
6573 iproc=iint_sent_local(k,jjc,ii)
6574 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6575 if (iproc.gt.0) then
6576 ncont_sent(iproc)=ncont_sent(iproc)+1
6577 nn=ncont_sent(iproc)
6579 zapas(2,nn,iproc)=jjc
6580 zapas(3,nn,iproc)=facont_hb(j,i)
6581 zapas(4,nn,iproc)=ees0p(j,i)
6582 zapas(5,nn,iproc)=ees0m(j,i)
6583 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6584 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6585 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6586 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6587 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6588 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6589 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6590 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6591 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6592 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6593 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6594 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6595 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6596 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6597 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6598 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6599 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6600 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6601 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6602 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6603 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6610 & "Numbers of contacts to be sent to other processors",
6611 & (ncont_sent(i),i=1,ntask_cont_to)
6612 write (iout,*) "Contacts sent"
6613 do ii=1,ntask_cont_to
6615 iproc=itask_cont_to(ii)
6616 write (iout,*) nn," contacts to processor",iproc,
6617 & " of CONT_TO_COMM group"
6619 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6627 CorrelID1=nfgtasks+fg_rank+1
6629 C Receive the numbers of needed contacts from other processors
6630 do ii=1,ntask_cont_from
6631 iproc=itask_cont_from(ii)
6633 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6634 & FG_COMM,req(ireq),IERR)
6636 c write (iout,*) "IRECV ended"
6638 C Send the number of contacts needed by other processors
6639 do ii=1,ntask_cont_to
6640 iproc=itask_cont_to(ii)
6642 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6643 & FG_COMM,req(ireq),IERR)
6645 c write (iout,*) "ISEND ended"
6646 c write (iout,*) "number of requests (nn)",ireq
6649 & call MPI_Waitall(ireq,req,status_array,ierr)
6651 c & "Numbers of contacts to be received from other processors",
6652 c & (ncont_recv(i),i=1,ntask_cont_from)
6656 do ii=1,ntask_cont_from
6657 iproc=itask_cont_from(ii)
6659 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6660 c & " of CONT_TO_COMM group"
6664 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6665 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6666 c write (iout,*) "ireq,req",ireq,req(ireq)
6669 C Send the contacts to processors that need them
6670 do ii=1,ntask_cont_to
6671 iproc=itask_cont_to(ii)
6673 c write (iout,*) nn," contacts to processor",iproc,
6674 c & " of CONT_TO_COMM group"
6677 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6678 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6679 c write (iout,*) "ireq,req",ireq,req(ireq)
6681 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6685 c write (iout,*) "number of requests (contacts)",ireq
6686 c write (iout,*) "req",(req(i),i=1,4)
6689 & call MPI_Waitall(ireq,req,status_array,ierr)
6690 do iii=1,ntask_cont_from
6691 iproc=itask_cont_from(iii)
6694 write (iout,*) "Received",nn," contacts from processor",iproc,
6695 & " of CONT_FROM_COMM group"
6698 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6703 ii=zapas_recv(1,i,iii)
6704 c Flag the received contacts to prevent double-counting
6705 jj=-zapas_recv(2,i,iii)
6706 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6708 nnn=num_cont_hb(ii)+1
6711 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6712 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6713 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6714 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6715 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6716 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6717 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6718 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6719 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6720 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6721 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6722 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6723 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6724 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6725 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6726 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6727 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6728 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6729 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6730 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6731 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6732 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6733 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6734 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6739 write (iout,'(a)') 'Contact function values after receive:'
6741 write (iout,'(2i3,50(1x,i3,f5.2))')
6742 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6743 & j=1,num_cont_hb(i))
6750 write (iout,'(a)') 'Contact function values:'
6752 write (iout,'(2i3,50(1x,i3,f5.2))')
6753 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6754 & j=1,num_cont_hb(i))
6758 C Remove the loop below after debugging !!!
6765 C Calculate the local-electrostatic correlation terms
6766 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6768 num_conti=num_cont_hb(i)
6769 num_conti1=num_cont_hb(i+1)
6776 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6777 c & ' jj=',jj,' kk=',kk
6778 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6779 & .or. j.lt.0 .and. j1.gt.0) .and.
6780 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6781 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6782 C The system gains extra energy.
6783 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6784 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6785 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6787 else if (j1.eq.j) then
6788 C Contacts I-J and I-(J+1) occur simultaneously.
6789 C The system loses extra energy.
6790 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6795 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6796 c & ' jj=',jj,' kk=',kk
6798 C Contacts I-J and (I+1)-J occur simultaneously.
6799 C The system loses extra energy.
6800 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6807 c------------------------------------------------------------------------------
6808 subroutine add_hb_contact(ii,jj,itask)
6809 implicit real*8 (a-h,o-z)
6810 include "DIMENSIONS"
6811 include "COMMON.IOUNITS"
6814 parameter (max_cont=maxconts)
6815 parameter (max_dim=26)
6816 include "COMMON.CONTACTS"
6817 double precision zapas(max_dim,maxconts,max_fg_procs),
6818 & zapas_recv(max_dim,maxconts,max_fg_procs)
6819 common /przechowalnia/ zapas
6820 integer i,j,ii,jj,iproc,itask(4),nn
6821 c write (iout,*) "itask",itask
6824 if (iproc.gt.0) then
6825 do j=1,num_cont_hb(ii)
6827 c write (iout,*) "i",ii," j",jj," jjc",jjc
6829 ncont_sent(iproc)=ncont_sent(iproc)+1
6830 nn=ncont_sent(iproc)
6831 zapas(1,nn,iproc)=ii
6832 zapas(2,nn,iproc)=jjc
6833 zapas(3,nn,iproc)=facont_hb(j,ii)
6834 zapas(4,nn,iproc)=ees0p(j,ii)
6835 zapas(5,nn,iproc)=ees0m(j,ii)
6836 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6837 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6838 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6839 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6840 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6841 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6842 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6843 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6844 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6845 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6846 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6847 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6848 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6849 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6850 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6851 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6852 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6853 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6854 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6855 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6856 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6864 c------------------------------------------------------------------------------
6865 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6867 C This subroutine calculates multi-body contributions to hydrogen-bonding
6868 implicit real*8 (a-h,o-z)
6869 include 'DIMENSIONS'
6870 include 'COMMON.IOUNITS'
6873 parameter (max_cont=maxconts)
6874 parameter (max_dim=70)
6875 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6876 double precision zapas(max_dim,maxconts,max_fg_procs),
6877 & zapas_recv(max_dim,maxconts,max_fg_procs)
6878 common /przechowalnia/ zapas
6879 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6880 & status_array(MPI_STATUS_SIZE,maxconts*2)
6882 include 'COMMON.SETUP'
6883 include 'COMMON.FFIELD'
6884 include 'COMMON.DERIV'
6885 include 'COMMON.LOCAL'
6886 include 'COMMON.INTERACT'
6887 include 'COMMON.CONTACTS'
6888 include 'COMMON.CHAIN'
6889 include 'COMMON.CONTROL'
6890 double precision gx(3),gx1(3)
6891 integer num_cont_hb_old(maxres)
6893 double precision eello4,eello5,eelo6,eello_turn6
6894 external eello4,eello5,eello6,eello_turn6
6895 C Set lprn=.true. for debugging
6900 num_cont_hb_old(i)=num_cont_hb(i)
6904 if (nfgtasks.le.1) goto 30
6906 write (iout,'(a)') 'Contact function values before RECEIVE:'
6908 write (iout,'(2i3,50(1x,i2,f5.2))')
6909 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6910 & j=1,num_cont_hb(i))
6914 do i=1,ntask_cont_from
6917 do i=1,ntask_cont_to
6920 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6922 C Make the list of contacts to send to send to other procesors
6923 do i=iturn3_start,iturn3_end
6924 c write (iout,*) "make contact list turn3",i," num_cont",
6926 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6928 do i=iturn4_start,iturn4_end
6929 c write (iout,*) "make contact list turn4",i," num_cont",
6931 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6935 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6937 do j=1,num_cont_hb(i)
6940 iproc=iint_sent_local(k,jjc,ii)
6941 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6942 if (iproc.ne.0) then
6943 ncont_sent(iproc)=ncont_sent(iproc)+1
6944 nn=ncont_sent(iproc)
6946 zapas(2,nn,iproc)=jjc
6947 zapas(3,nn,iproc)=d_cont(j,i)
6951 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6956 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6964 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6975 & "Numbers of contacts to be sent to other processors",
6976 & (ncont_sent(i),i=1,ntask_cont_to)
6977 write (iout,*) "Contacts sent"
6978 do ii=1,ntask_cont_to
6980 iproc=itask_cont_to(ii)
6981 write (iout,*) nn," contacts to processor",iproc,
6982 & " of CONT_TO_COMM group"
6984 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6992 CorrelID1=nfgtasks+fg_rank+1
6994 C Receive the numbers of needed contacts from other processors
6995 do ii=1,ntask_cont_from
6996 iproc=itask_cont_from(ii)
6998 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6999 & FG_COMM,req(ireq),IERR)
7001 c write (iout,*) "IRECV ended"
7003 C Send the number of contacts needed by other processors
7004 do ii=1,ntask_cont_to
7005 iproc=itask_cont_to(ii)
7007 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7008 & FG_COMM,req(ireq),IERR)
7010 c write (iout,*) "ISEND ended"
7011 c write (iout,*) "number of requests (nn)",ireq
7014 & call MPI_Waitall(ireq,req,status_array,ierr)
7016 c & "Numbers of contacts to be received from other processors",
7017 c & (ncont_recv(i),i=1,ntask_cont_from)
7021 do ii=1,ntask_cont_from
7022 iproc=itask_cont_from(ii)
7024 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7025 c & " of CONT_TO_COMM group"
7029 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7030 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7031 c write (iout,*) "ireq,req",ireq,req(ireq)
7034 C Send the contacts to processors that need them
7035 do ii=1,ntask_cont_to
7036 iproc=itask_cont_to(ii)
7038 c write (iout,*) nn," contacts to processor",iproc,
7039 c & " of CONT_TO_COMM group"
7042 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7043 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7044 c write (iout,*) "ireq,req",ireq,req(ireq)
7046 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7050 c write (iout,*) "number of requests (contacts)",ireq
7051 c write (iout,*) "req",(req(i),i=1,4)
7054 & call MPI_Waitall(ireq,req,status_array,ierr)
7055 do iii=1,ntask_cont_from
7056 iproc=itask_cont_from(iii)
7059 write (iout,*) "Received",nn," contacts from processor",iproc,
7060 & " of CONT_FROM_COMM group"
7063 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7068 ii=zapas_recv(1,i,iii)
7069 c Flag the received contacts to prevent double-counting
7070 jj=-zapas_recv(2,i,iii)
7071 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7073 nnn=num_cont_hb(ii)+1
7076 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7080 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7085 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7093 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7102 write (iout,'(a)') 'Contact function values after receive:'
7104 write (iout,'(2i3,50(1x,i3,5f6.3))')
7105 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7106 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7113 write (iout,'(a)') 'Contact function values:'
7115 write (iout,'(2i3,50(1x,i2,5f6.3))')
7116 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7117 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7123 C Remove the loop below after debugging !!!
7130 C Calculate the dipole-dipole interaction energies
7131 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7132 do i=iatel_s,iatel_e+1
7133 num_conti=num_cont_hb(i)
7142 C Calculate the local-electrostatic correlation terms
7143 c write (iout,*) "gradcorr5 in eello5 before loop"
7145 c write (iout,'(i5,3f10.5)')
7146 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7148 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7149 c write (iout,*) "corr loop i",i
7151 num_conti=num_cont_hb(i)
7152 num_conti1=num_cont_hb(i+1)
7159 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7160 c & ' jj=',jj,' kk=',kk
7161 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7162 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7163 & .or. j.lt.0 .and. j1.gt.0) .and.
7164 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7165 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7166 C The system gains extra energy.
7168 sqd1=dsqrt(d_cont(jj,i))
7169 sqd2=dsqrt(d_cont(kk,i1))
7170 sred_geom = sqd1*sqd2
7171 IF (sred_geom.lt.cutoff_corr) THEN
7172 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7174 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7175 cd & ' jj=',jj,' kk=',kk
7176 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7177 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7179 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7180 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7183 cd write (iout,*) 'sred_geom=',sred_geom,
7184 cd & ' ekont=',ekont,' fprim=',fprimcont,
7185 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7186 cd write (iout,*) "g_contij",g_contij
7187 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7188 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7189 call calc_eello(i,jp,i+1,jp1,jj,kk)
7190 if (wcorr4.gt.0.0d0)
7191 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7192 if (energy_dec.and.wcorr4.gt.0.0d0)
7193 1 write (iout,'(a6,4i5,0pf7.3)')
7194 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7195 c write (iout,*) "gradcorr5 before eello5"
7197 c write (iout,'(i5,3f10.5)')
7198 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7200 if (wcorr5.gt.0.0d0)
7201 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7202 c write (iout,*) "gradcorr5 after eello5"
7204 c write (iout,'(i5,3f10.5)')
7205 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7207 if (energy_dec.and.wcorr5.gt.0.0d0)
7208 1 write (iout,'(a6,4i5,0pf7.3)')
7209 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7210 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7211 cd write(2,*)'ijkl',i,jp,i+1,jp1
7212 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7213 & .or. wturn6.eq.0.0d0))then
7214 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7215 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7216 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7217 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7218 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7219 cd & 'ecorr6=',ecorr6
7220 cd write (iout,'(4e15.5)') sred_geom,
7221 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7222 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7223 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7224 else if (wturn6.gt.0.0d0
7225 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7226 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7227 eturn6=eturn6+eello_turn6(i,jj,kk)
7228 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7229 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7230 cd write (2,*) 'multibody_eello:eturn6',eturn6
7239 num_cont_hb(i)=num_cont_hb_old(i)
7241 c write (iout,*) "gradcorr5 in eello5"
7243 c write (iout,'(i5,3f10.5)')
7244 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7248 c------------------------------------------------------------------------------
7249 subroutine add_hb_contact_eello(ii,jj,itask)
7250 implicit real*8 (a-h,o-z)
7251 include "DIMENSIONS"
7252 include "COMMON.IOUNITS"
7255 parameter (max_cont=maxconts)
7256 parameter (max_dim=70)
7257 include "COMMON.CONTACTS"
7258 double precision zapas(max_dim,maxconts,max_fg_procs),
7259 & zapas_recv(max_dim,maxconts,max_fg_procs)
7260 common /przechowalnia/ zapas
7261 integer i,j,ii,jj,iproc,itask(4),nn
7262 c write (iout,*) "itask",itask
7265 if (iproc.gt.0) then
7266 do j=1,num_cont_hb(ii)
7268 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7270 ncont_sent(iproc)=ncont_sent(iproc)+1
7271 nn=ncont_sent(iproc)
7272 zapas(1,nn,iproc)=ii
7273 zapas(2,nn,iproc)=jjc
7274 zapas(3,nn,iproc)=d_cont(j,ii)
7278 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7283 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7291 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7303 c------------------------------------------------------------------------------
7304 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7305 implicit real*8 (a-h,o-z)
7306 include 'DIMENSIONS'
7307 include 'COMMON.IOUNITS'
7308 include 'COMMON.DERIV'
7309 include 'COMMON.INTERACT'
7310 include 'COMMON.CONTACTS'
7311 double precision gx(3),gx1(3)
7321 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7322 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7323 C Following 4 lines for diagnostics.
7328 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7329 c & 'Contacts ',i,j,
7330 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7331 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7333 C Calculate the multi-body contribution to energy.
7334 c ecorr=ecorr+ekont*ees
7335 C Calculate multi-body contributions to the gradient.
7336 coeffpees0pij=coeffp*ees0pij
7337 coeffmees0mij=coeffm*ees0mij
7338 coeffpees0pkl=coeffp*ees0pkl
7339 coeffmees0mkl=coeffm*ees0mkl
7341 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7342 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7343 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7344 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7345 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7346 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7347 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7348 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7349 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7350 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7351 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7352 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7353 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7354 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7355 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7356 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7357 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7358 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7359 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7360 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7361 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7362 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7363 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7364 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7365 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7370 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7371 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7372 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7373 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7378 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7379 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7380 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7381 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7384 c write (iout,*) "ehbcorr",ekont*ees
7389 C---------------------------------------------------------------------------
7390 subroutine dipole(i,j,jj)
7391 implicit real*8 (a-h,o-z)
7392 include 'DIMENSIONS'
7393 include 'COMMON.IOUNITS'
7394 include 'COMMON.CHAIN'
7395 include 'COMMON.FFIELD'
7396 include 'COMMON.DERIV'
7397 include 'COMMON.INTERACT'
7398 include 'COMMON.CONTACTS'
7399 include 'COMMON.TORSION'
7400 include 'COMMON.VAR'
7401 include 'COMMON.GEO'
7402 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7404 iti1 = itortyp(itype(i+1))
7405 if (j.lt.nres-1) then
7406 itj1 = itortyp(itype(j+1))
7411 dipi(iii,1)=Ub2(iii,i)
7412 dipderi(iii)=Ub2der(iii,i)
7413 dipi(iii,2)=b1(iii,iti1)
7414 dipj(iii,1)=Ub2(iii,j)
7415 dipderj(iii)=Ub2der(iii,j)
7416 dipj(iii,2)=b1(iii,itj1)
7420 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7423 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7430 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7434 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7439 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7440 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7442 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7444 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7446 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7451 C---------------------------------------------------------------------------
7452 subroutine calc_eello(i,j,k,l,jj,kk)
7454 C This subroutine computes matrices and vectors needed to calculate
7455 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7457 implicit real*8 (a-h,o-z)
7458 include 'DIMENSIONS'
7459 include 'COMMON.IOUNITS'
7460 include 'COMMON.CHAIN'
7461 include 'COMMON.DERIV'
7462 include 'COMMON.INTERACT'
7463 include 'COMMON.CONTACTS'
7464 include 'COMMON.TORSION'
7465 include 'COMMON.VAR'
7466 include 'COMMON.GEO'
7467 include 'COMMON.FFIELD'
7468 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7469 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7472 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7473 cd & ' jj=',jj,' kk=',kk
7474 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7475 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7476 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7479 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7480 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7483 call transpose2(aa1(1,1),aa1t(1,1))
7484 call transpose2(aa2(1,1),aa2t(1,1))
7487 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7488 & aa1tder(1,1,lll,kkk))
7489 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7490 & aa2tder(1,1,lll,kkk))
7494 C parallel orientation of the two CA-CA-CA frames.
7496 iti=itortyp(itype(i))
7500 itk1=itortyp(itype(k+1))
7501 itj=itortyp(itype(j))
7502 if (l.lt.nres-1) then
7503 itl1=itortyp(itype(l+1))
7507 C A1 kernel(j+1) A2T
7509 cd write (iout,'(3f10.5,5x,3f10.5)')
7510 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7512 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7513 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7514 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7515 C Following matrices are needed only for 6-th order cumulants
7516 IF (wcorr6.gt.0.0d0) THEN
7517 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7518 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7519 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7520 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7521 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7522 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7523 & ADtEAderx(1,1,1,1,1,1))
7525 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7526 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7527 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7528 & ADtEA1derx(1,1,1,1,1,1))
7530 C End 6-th order cumulants
7533 cd write (2,*) 'In calc_eello6'
7535 cd write (2,*) 'iii=',iii
7537 cd write (2,*) 'kkk=',kkk
7539 cd write (2,'(3(2f10.5),5x)')
7540 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7545 call transpose2(EUgder(1,1,k),auxmat(1,1))
7546 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7547 call transpose2(EUg(1,1,k),auxmat(1,1))
7548 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7549 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7553 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7554 & EAEAderx(1,1,lll,kkk,iii,1))
7558 C A1T kernel(i+1) A2
7559 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7560 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7561 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7562 C Following matrices are needed only for 6-th order cumulants
7563 IF (wcorr6.gt.0.0d0) THEN
7564 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7565 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7566 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7567 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7568 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7569 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7570 & ADtEAderx(1,1,1,1,1,2))
7571 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7572 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7573 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7574 & ADtEA1derx(1,1,1,1,1,2))
7576 C End 6-th order cumulants
7577 call transpose2(EUgder(1,1,l),auxmat(1,1))
7578 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7579 call transpose2(EUg(1,1,l),auxmat(1,1))
7580 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7581 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7585 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7586 & EAEAderx(1,1,lll,kkk,iii,2))
7591 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7592 C They are needed only when the fifth- or the sixth-order cumulants are
7594 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7595 call transpose2(AEA(1,1,1),auxmat(1,1))
7596 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7597 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7598 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7599 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7600 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7601 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7602 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7603 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7604 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7605 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7606 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7607 call transpose2(AEA(1,1,2),auxmat(1,1))
7608 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7609 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7610 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7611 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7612 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7613 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7614 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7615 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7616 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7617 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7618 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7619 C Calculate the Cartesian derivatives of the vectors.
7623 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7624 call matvec2(auxmat(1,1),b1(1,iti),
7625 & AEAb1derx(1,lll,kkk,iii,1,1))
7626 call matvec2(auxmat(1,1),Ub2(1,i),
7627 & AEAb2derx(1,lll,kkk,iii,1,1))
7628 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7629 & AEAb1derx(1,lll,kkk,iii,2,1))
7630 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7631 & AEAb2derx(1,lll,kkk,iii,2,1))
7632 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7633 call matvec2(auxmat(1,1),b1(1,itj),
7634 & AEAb1derx(1,lll,kkk,iii,1,2))
7635 call matvec2(auxmat(1,1),Ub2(1,j),
7636 & AEAb2derx(1,lll,kkk,iii,1,2))
7637 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7638 & AEAb1derx(1,lll,kkk,iii,2,2))
7639 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7640 & AEAb2derx(1,lll,kkk,iii,2,2))
7647 C Antiparallel orientation of the two CA-CA-CA frames.
7649 iti=itortyp(itype(i))
7653 itk1=itortyp(itype(k+1))
7654 itl=itortyp(itype(l))
7655 itj=itortyp(itype(j))
7656 if (j.lt.nres-1) then
7657 itj1=itortyp(itype(j+1))
7661 C A2 kernel(j-1)T A1T
7662 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7663 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7664 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7665 C Following matrices are needed only for 6-th order cumulants
7666 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7667 & j.eq.i+4 .and. l.eq.i+3)) THEN
7668 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7669 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7670 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7671 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7672 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7673 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7674 & ADtEAderx(1,1,1,1,1,1))
7675 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7676 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7677 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7678 & ADtEA1derx(1,1,1,1,1,1))
7680 C End 6-th order cumulants
7681 call transpose2(EUgder(1,1,k),auxmat(1,1))
7682 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7683 call transpose2(EUg(1,1,k),auxmat(1,1))
7684 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7685 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7689 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7690 & EAEAderx(1,1,lll,kkk,iii,1))
7694 C A2T kernel(i+1)T A1
7695 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7696 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7697 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7698 C Following matrices are needed only for 6-th order cumulants
7699 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7700 & j.eq.i+4 .and. l.eq.i+3)) THEN
7701 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7702 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7703 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7704 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7705 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7706 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7707 & ADtEAderx(1,1,1,1,1,2))
7708 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7709 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7710 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7711 & ADtEA1derx(1,1,1,1,1,2))
7713 C End 6-th order cumulants
7714 call transpose2(EUgder(1,1,j),auxmat(1,1))
7715 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7716 call transpose2(EUg(1,1,j),auxmat(1,1))
7717 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7718 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7722 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7723 & EAEAderx(1,1,lll,kkk,iii,2))
7728 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7729 C They are needed only when the fifth- or the sixth-order cumulants are
7731 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7732 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7733 call transpose2(AEA(1,1,1),auxmat(1,1))
7734 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7735 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7736 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7737 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7738 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7739 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7740 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7741 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7742 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7743 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7744 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7745 call transpose2(AEA(1,1,2),auxmat(1,1))
7746 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7747 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7748 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7749 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7750 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7751 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7752 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7753 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7754 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7755 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7756 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7757 C Calculate the Cartesian derivatives of the vectors.
7761 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7762 call matvec2(auxmat(1,1),b1(1,iti),
7763 & AEAb1derx(1,lll,kkk,iii,1,1))
7764 call matvec2(auxmat(1,1),Ub2(1,i),
7765 & AEAb2derx(1,lll,kkk,iii,1,1))
7766 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7767 & AEAb1derx(1,lll,kkk,iii,2,1))
7768 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7769 & AEAb2derx(1,lll,kkk,iii,2,1))
7770 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7771 call matvec2(auxmat(1,1),b1(1,itl),
7772 & AEAb1derx(1,lll,kkk,iii,1,2))
7773 call matvec2(auxmat(1,1),Ub2(1,l),
7774 & AEAb2derx(1,lll,kkk,iii,1,2))
7775 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7776 & AEAb1derx(1,lll,kkk,iii,2,2))
7777 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7778 & AEAb2derx(1,lll,kkk,iii,2,2))
7787 C---------------------------------------------------------------------------
7788 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7789 & KK,KKderg,AKA,AKAderg,AKAderx)
7793 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7794 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7795 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7800 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7802 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7805 cd if (lprn) write (2,*) 'In kernel'
7807 cd if (lprn) write (2,*) 'kkk=',kkk
7809 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7810 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7812 cd write (2,*) 'lll=',lll
7813 cd write (2,*) 'iii=1'
7815 cd write (2,'(3(2f10.5),5x)')
7816 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7819 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7820 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7822 cd write (2,*) 'lll=',lll
7823 cd write (2,*) 'iii=2'
7825 cd write (2,'(3(2f10.5),5x)')
7826 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7833 C---------------------------------------------------------------------------
7834 double precision function eello4(i,j,k,l,jj,kk)
7835 implicit real*8 (a-h,o-z)
7836 include 'DIMENSIONS'
7837 include 'COMMON.IOUNITS'
7838 include 'COMMON.CHAIN'
7839 include 'COMMON.DERIV'
7840 include 'COMMON.INTERACT'
7841 include 'COMMON.CONTACTS'
7842 include 'COMMON.TORSION'
7843 include 'COMMON.VAR'
7844 include 'COMMON.GEO'
7845 double precision pizda(2,2),ggg1(3),ggg2(3)
7846 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7850 cd print *,'eello4:',i,j,k,l,jj,kk
7851 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7852 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7853 cold eij=facont_hb(jj,i)
7854 cold ekl=facont_hb(kk,k)
7856 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7857 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7858 gcorr_loc(k-1)=gcorr_loc(k-1)
7859 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7861 gcorr_loc(l-1)=gcorr_loc(l-1)
7862 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7864 gcorr_loc(j-1)=gcorr_loc(j-1)
7865 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7870 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7871 & -EAEAderx(2,2,lll,kkk,iii,1)
7872 cd derx(lll,kkk,iii)=0.0d0
7876 cd gcorr_loc(l-1)=0.0d0
7877 cd gcorr_loc(j-1)=0.0d0
7878 cd gcorr_loc(k-1)=0.0d0
7880 cd write (iout,*)'Contacts have occurred for peptide groups',
7881 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7882 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7883 if (j.lt.nres-1) then
7890 if (l.lt.nres-1) then
7898 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7899 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7900 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7901 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7902 cgrad ghalf=0.5d0*ggg1(ll)
7903 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7904 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7905 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7906 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7907 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7908 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7909 cgrad ghalf=0.5d0*ggg2(ll)
7910 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7911 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7912 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7913 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7914 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7915 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7919 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7924 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7929 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7934 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7938 cd write (2,*) iii,gcorr_loc(iii)
7941 cd write (2,*) 'ekont',ekont
7942 cd write (iout,*) 'eello4',ekont*eel4
7945 C---------------------------------------------------------------------------
7946 double precision function eello5(i,j,k,l,jj,kk)
7947 implicit real*8 (a-h,o-z)
7948 include 'DIMENSIONS'
7949 include 'COMMON.IOUNITS'
7950 include 'COMMON.CHAIN'
7951 include 'COMMON.DERIV'
7952 include 'COMMON.INTERACT'
7953 include 'COMMON.CONTACTS'
7954 include 'COMMON.TORSION'
7955 include 'COMMON.VAR'
7956 include 'COMMON.GEO'
7957 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7958 double precision ggg1(3),ggg2(3)
7959 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7964 C /l\ / \ \ / \ / \ / C
7965 C / \ / \ \ / \ / \ / C
7966 C j| o |l1 | o | o| o | | o |o C
7967 C \ |/k\| |/ \| / |/ \| |/ \| C
7968 C \i/ \ / \ / / \ / \ C
7970 C (I) (II) (III) (IV) C
7972 C eello5_1 eello5_2 eello5_3 eello5_4 C
7974 C Antiparallel chains C
7977 C /j\ / \ \ / \ / \ / C
7978 C / \ / \ \ / \ / \ / C
7979 C j1| o |l | o | o| o | | o |o C
7980 C \ |/k\| |/ \| / |/ \| |/ \| C
7981 C \i/ \ / \ / / \ / \ C
7983 C (I) (II) (III) (IV) C
7985 C eello5_1 eello5_2 eello5_3 eello5_4 C
7987 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7989 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7990 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7995 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7997 itk=itortyp(itype(k))
7998 itl=itortyp(itype(l))
7999 itj=itortyp(itype(j))
8004 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8005 cd & eel5_3_num,eel5_4_num)
8009 derx(lll,kkk,iii)=0.0d0
8013 cd eij=facont_hb(jj,i)
8014 cd ekl=facont_hb(kk,k)
8016 cd write (iout,*)'Contacts have occurred for peptide groups',
8017 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8019 C Contribution from the graph I.
8020 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8021 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8022 call transpose2(EUg(1,1,k),auxmat(1,1))
8023 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8024 vv(1)=pizda(1,1)-pizda(2,2)
8025 vv(2)=pizda(1,2)+pizda(2,1)
8026 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8027 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8028 C Explicit gradient in virtual-dihedral angles.
8029 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8030 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8031 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8032 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8033 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8034 vv(1)=pizda(1,1)-pizda(2,2)
8035 vv(2)=pizda(1,2)+pizda(2,1)
8036 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8037 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8038 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8039 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8040 vv(1)=pizda(1,1)-pizda(2,2)
8041 vv(2)=pizda(1,2)+pizda(2,1)
8043 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8044 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8045 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8047 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8048 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8049 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8051 C Cartesian gradient
8055 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8057 vv(1)=pizda(1,1)-pizda(2,2)
8058 vv(2)=pizda(1,2)+pizda(2,1)
8059 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8060 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8061 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8067 C Contribution from graph II
8068 call transpose2(EE(1,1,itk),auxmat(1,1))
8069 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8070 vv(1)=pizda(1,1)+pizda(2,2)
8071 vv(2)=pizda(2,1)-pizda(1,2)
8072 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
8073 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8074 C Explicit gradient in virtual-dihedral angles.
8075 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8076 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8077 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8078 vv(1)=pizda(1,1)+pizda(2,2)
8079 vv(2)=pizda(2,1)-pizda(1,2)
8081 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8082 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8083 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8085 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8086 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8087 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8089 C Cartesian gradient
8093 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8095 vv(1)=pizda(1,1)+pizda(2,2)
8096 vv(2)=pizda(2,1)-pizda(1,2)
8097 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8098 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
8099 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8107 C Parallel orientation
8108 C Contribution from graph III
8109 call transpose2(EUg(1,1,l),auxmat(1,1))
8110 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8111 vv(1)=pizda(1,1)-pizda(2,2)
8112 vv(2)=pizda(1,2)+pizda(2,1)
8113 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8114 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8115 C Explicit gradient in virtual-dihedral angles.
8116 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8117 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8118 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8119 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8120 vv(1)=pizda(1,1)-pizda(2,2)
8121 vv(2)=pizda(1,2)+pizda(2,1)
8122 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8123 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8124 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8125 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8126 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8127 vv(1)=pizda(1,1)-pizda(2,2)
8128 vv(2)=pizda(1,2)+pizda(2,1)
8129 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8130 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8131 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8132 C Cartesian gradient
8136 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8138 vv(1)=pizda(1,1)-pizda(2,2)
8139 vv(2)=pizda(1,2)+pizda(2,1)
8140 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8141 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8142 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8147 C Contribution from graph IV
8149 call transpose2(EE(1,1,itl),auxmat(1,1))
8150 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8151 vv(1)=pizda(1,1)+pizda(2,2)
8152 vv(2)=pizda(2,1)-pizda(1,2)
8153 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
8154 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8155 C Explicit gradient in virtual-dihedral angles.
8156 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8157 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8158 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8159 vv(1)=pizda(1,1)+pizda(2,2)
8160 vv(2)=pizda(2,1)-pizda(1,2)
8161 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8162 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
8163 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8164 C Cartesian gradient
8168 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8170 vv(1)=pizda(1,1)+pizda(2,2)
8171 vv(2)=pizda(2,1)-pizda(1,2)
8172 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8173 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
8174 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8179 C Antiparallel orientation
8180 C Contribution from graph III
8182 call transpose2(EUg(1,1,j),auxmat(1,1))
8183 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8184 vv(1)=pizda(1,1)-pizda(2,2)
8185 vv(2)=pizda(1,2)+pizda(2,1)
8186 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8187 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8188 C Explicit gradient in virtual-dihedral angles.
8189 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8190 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8191 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8192 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8193 vv(1)=pizda(1,1)-pizda(2,2)
8194 vv(2)=pizda(1,2)+pizda(2,1)
8195 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8196 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8197 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8198 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8199 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8200 vv(1)=pizda(1,1)-pizda(2,2)
8201 vv(2)=pizda(1,2)+pizda(2,1)
8202 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8203 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8204 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8205 C Cartesian gradient
8209 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8211 vv(1)=pizda(1,1)-pizda(2,2)
8212 vv(2)=pizda(1,2)+pizda(2,1)
8213 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8214 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8215 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8220 C Contribution from graph IV
8222 call transpose2(EE(1,1,itj),auxmat(1,1))
8223 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8224 vv(1)=pizda(1,1)+pizda(2,2)
8225 vv(2)=pizda(2,1)-pizda(1,2)
8226 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
8227 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8228 C Explicit gradient in virtual-dihedral angles.
8229 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8230 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8231 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8232 vv(1)=pizda(1,1)+pizda(2,2)
8233 vv(2)=pizda(2,1)-pizda(1,2)
8234 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8235 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
8236 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8237 C Cartesian gradient
8241 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8243 vv(1)=pizda(1,1)+pizda(2,2)
8244 vv(2)=pizda(2,1)-pizda(1,2)
8245 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8246 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
8247 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8253 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8254 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8255 cd write (2,*) 'ijkl',i,j,k,l
8256 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8257 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8259 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8260 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8261 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8262 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8263 if (j.lt.nres-1) then
8270 if (l.lt.nres-1) then
8280 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8281 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8282 C summed up outside the subrouine as for the other subroutines
8283 C handling long-range interactions. The old code is commented out
8284 C with "cgrad" to keep track of changes.
8286 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8287 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8288 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8289 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8290 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8291 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8292 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8293 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8294 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8295 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8297 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8298 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8299 cgrad ghalf=0.5d0*ggg1(ll)
8301 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8302 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8303 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8304 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8305 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8306 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8307 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8308 cgrad ghalf=0.5d0*ggg2(ll)
8310 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8311 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8312 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8313 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8314 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8315 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8320 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8321 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8326 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8327 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8333 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8338 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8342 cd write (2,*) iii,g_corr5_loc(iii)
8345 cd write (2,*) 'ekont',ekont
8346 cd write (iout,*) 'eello5',ekont*eel5
8349 c--------------------------------------------------------------------------
8350 double precision function eello6(i,j,k,l,jj,kk)
8351 implicit real*8 (a-h,o-z)
8352 include 'DIMENSIONS'
8353 include 'COMMON.IOUNITS'
8354 include 'COMMON.CHAIN'
8355 include 'COMMON.DERIV'
8356 include 'COMMON.INTERACT'
8357 include 'COMMON.CONTACTS'
8358 include 'COMMON.TORSION'
8359 include 'COMMON.VAR'
8360 include 'COMMON.GEO'
8361 include 'COMMON.FFIELD'
8362 double precision ggg1(3),ggg2(3)
8363 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8368 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8376 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8377 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8381 derx(lll,kkk,iii)=0.0d0
8385 cd eij=facont_hb(jj,i)
8386 cd ekl=facont_hb(kk,k)
8392 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8393 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8394 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8395 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8396 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8397 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8399 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8400 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8401 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8402 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8403 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8404 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8408 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8410 C If turn contributions are considered, they will be handled separately.
8411 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8412 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8413 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8414 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8415 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8416 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8417 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8419 if (j.lt.nres-1) then
8426 if (l.lt.nres-1) then
8434 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8435 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8436 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8437 cgrad ghalf=0.5d0*ggg1(ll)
8439 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8440 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8441 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8442 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8443 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8444 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8445 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8446 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8447 cgrad ghalf=0.5d0*ggg2(ll)
8448 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8450 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8451 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8452 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8453 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8454 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8455 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8460 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8461 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8466 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8467 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8473 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8478 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8482 cd write (2,*) iii,g_corr6_loc(iii)
8485 cd write (2,*) 'ekont',ekont
8486 cd write (iout,*) 'eello6',ekont*eel6
8489 c--------------------------------------------------------------------------
8490 double precision function eello6_graph1(i,j,k,l,imat,swap)
8491 implicit real*8 (a-h,o-z)
8492 include 'DIMENSIONS'
8493 include 'COMMON.IOUNITS'
8494 include 'COMMON.CHAIN'
8495 include 'COMMON.DERIV'
8496 include 'COMMON.INTERACT'
8497 include 'COMMON.CONTACTS'
8498 include 'COMMON.TORSION'
8499 include 'COMMON.VAR'
8500 include 'COMMON.GEO'
8501 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8505 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8507 C Parallel Antiparallel C
8513 C \ j|/k\| / \ |/k\|l / C
8518 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8519 itk=itortyp(itype(k))
8520 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8521 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8522 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8523 call transpose2(EUgC(1,1,k),auxmat(1,1))
8524 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8525 vv1(1)=pizda1(1,1)-pizda1(2,2)
8526 vv1(2)=pizda1(1,2)+pizda1(2,1)
8527 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8528 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8529 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8530 s5=scalar2(vv(1),Dtobr2(1,i))
8531 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8532 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8533 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8534 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8535 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8536 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8537 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8538 & +scalar2(vv(1),Dtobr2der(1,i)))
8539 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8540 vv1(1)=pizda1(1,1)-pizda1(2,2)
8541 vv1(2)=pizda1(1,2)+pizda1(2,1)
8542 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8543 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8545 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8546 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8547 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8548 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8549 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8551 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8552 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8553 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8554 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8555 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8557 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8558 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8559 vv1(1)=pizda1(1,1)-pizda1(2,2)
8560 vv1(2)=pizda1(1,2)+pizda1(2,1)
8561 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8562 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8563 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8564 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8573 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8574 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8575 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8576 call transpose2(EUgC(1,1,k),auxmat(1,1))
8577 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8579 vv1(1)=pizda1(1,1)-pizda1(2,2)
8580 vv1(2)=pizda1(1,2)+pizda1(2,1)
8581 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8582 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8583 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8584 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8585 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8586 s5=scalar2(vv(1),Dtobr2(1,i))
8587 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8593 c----------------------------------------------------------------------------
8594 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8595 implicit real*8 (a-h,o-z)
8596 include 'DIMENSIONS'
8597 include 'COMMON.IOUNITS'
8598 include 'COMMON.CHAIN'
8599 include 'COMMON.DERIV'
8600 include 'COMMON.INTERACT'
8601 include 'COMMON.CONTACTS'
8602 include 'COMMON.TORSION'
8603 include 'COMMON.VAR'
8604 include 'COMMON.GEO'
8606 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8607 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8610 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8612 C Parallel Antiparallel C
8618 C \ j|/k\| \ |/k\|l C
8623 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8624 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8625 C AL 7/4/01 s1 would occur in the sixth-order moment,
8626 C but not in a cluster cumulant
8628 s1=dip(1,jj,i)*dip(1,kk,k)
8630 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8631 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8632 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8633 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8634 call transpose2(EUg(1,1,k),auxmat(1,1))
8635 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8636 vv(1)=pizda(1,1)-pizda(2,2)
8637 vv(2)=pizda(1,2)+pizda(2,1)
8638 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8639 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8641 eello6_graph2=-(s1+s2+s3+s4)
8643 eello6_graph2=-(s2+s3+s4)
8646 C Derivatives in gamma(i-1)
8649 s1=dipderg(1,jj,i)*dip(1,kk,k)
8651 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8652 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8653 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8654 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8656 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8658 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8660 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8662 C Derivatives in gamma(k-1)
8664 s1=dip(1,jj,i)*dipderg(1,kk,k)
8666 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8667 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8668 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8669 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8670 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8671 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8672 vv(1)=pizda(1,1)-pizda(2,2)
8673 vv(2)=pizda(1,2)+pizda(2,1)
8674 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8676 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8678 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8680 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8681 C Derivatives in gamma(j-1) or gamma(l-1)
8684 s1=dipderg(3,jj,i)*dip(1,kk,k)
8686 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8687 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8688 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8689 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8690 vv(1)=pizda(1,1)-pizda(2,2)
8691 vv(2)=pizda(1,2)+pizda(2,1)
8692 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8695 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8697 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8700 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8701 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8703 C Derivatives in gamma(l-1) or gamma(j-1)
8706 s1=dip(1,jj,i)*dipderg(3,kk,k)
8708 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8709 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8710 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8711 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8712 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8713 vv(1)=pizda(1,1)-pizda(2,2)
8714 vv(2)=pizda(1,2)+pizda(2,1)
8715 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8718 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8720 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8723 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8724 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8726 C Cartesian derivatives.
8728 write (2,*) 'In eello6_graph2'
8730 write (2,*) 'iii=',iii
8732 write (2,*) 'kkk=',kkk
8734 write (2,'(3(2f10.5),5x)')
8735 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8745 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8747 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8750 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8752 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8753 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8755 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8756 call transpose2(EUg(1,1,k),auxmat(1,1))
8757 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8759 vv(1)=pizda(1,1)-pizda(2,2)
8760 vv(2)=pizda(1,2)+pizda(2,1)
8761 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8762 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8764 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8766 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8769 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8771 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8778 c----------------------------------------------------------------------------
8779 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8780 implicit real*8 (a-h,o-z)
8781 include 'DIMENSIONS'
8782 include 'COMMON.IOUNITS'
8783 include 'COMMON.CHAIN'
8784 include 'COMMON.DERIV'
8785 include 'COMMON.INTERACT'
8786 include 'COMMON.CONTACTS'
8787 include 'COMMON.TORSION'
8788 include 'COMMON.VAR'
8789 include 'COMMON.GEO'
8790 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8792 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8794 C Parallel Antiparallel C
8800 C j|/k\| / |/k\|l / C
8805 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8807 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8808 C energy moment and not to the cluster cumulant.
8809 iti=itortyp(itype(i))
8810 if (j.lt.nres-1) then
8811 itj1=itortyp(itype(j+1))
8815 itk=itortyp(itype(k))
8816 itk1=itortyp(itype(k+1))
8817 if (l.lt.nres-1) then
8818 itl1=itortyp(itype(l+1))
8823 s1=dip(4,jj,i)*dip(4,kk,k)
8825 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8826 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8827 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8828 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8829 call transpose2(EE(1,1,itk),auxmat(1,1))
8830 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8831 vv(1)=pizda(1,1)+pizda(2,2)
8832 vv(2)=pizda(2,1)-pizda(1,2)
8833 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8834 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8835 cd & "sum",-(s2+s3+s4)
8837 eello6_graph3=-(s1+s2+s3+s4)
8839 eello6_graph3=-(s2+s3+s4)
8842 C Derivatives in gamma(k-1)
8843 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8844 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8845 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8846 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8847 C Derivatives in gamma(l-1)
8848 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8849 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8850 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8851 vv(1)=pizda(1,1)+pizda(2,2)
8852 vv(2)=pizda(2,1)-pizda(1,2)
8853 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8854 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8855 C Cartesian derivatives.
8861 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8863 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8866 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8868 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8869 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8871 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8872 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8874 vv(1)=pizda(1,1)+pizda(2,2)
8875 vv(2)=pizda(2,1)-pizda(1,2)
8876 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8878 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8880 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8883 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8885 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8887 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8893 c----------------------------------------------------------------------------
8894 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8895 implicit real*8 (a-h,o-z)
8896 include 'DIMENSIONS'
8897 include 'COMMON.IOUNITS'
8898 include 'COMMON.CHAIN'
8899 include 'COMMON.DERIV'
8900 include 'COMMON.INTERACT'
8901 include 'COMMON.CONTACTS'
8902 include 'COMMON.TORSION'
8903 include 'COMMON.VAR'
8904 include 'COMMON.GEO'
8905 include 'COMMON.FFIELD'
8906 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8907 & auxvec1(2),auxmat1(2,2)
8909 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8911 C Parallel Antiparallel C
8917 C \ j|/k\| \ |/k\|l C
8922 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8924 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8925 C energy moment and not to the cluster cumulant.
8926 cd write (2,*) 'eello_graph4: wturn6',wturn6
8927 iti=itortyp(itype(i))
8928 itj=itortyp(itype(j))
8929 if (j.lt.nres-1) then
8930 itj1=itortyp(itype(j+1))
8934 itk=itortyp(itype(k))
8935 if (k.lt.nres-1) then
8936 itk1=itortyp(itype(k+1))
8940 itl=itortyp(itype(l))
8941 if (l.lt.nres-1) then
8942 itl1=itortyp(itype(l+1))
8946 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8947 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8948 cd & ' itl',itl,' itl1',itl1
8951 s1=dip(3,jj,i)*dip(3,kk,k)
8953 s1=dip(2,jj,j)*dip(2,kk,l)
8956 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8957 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8959 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8960 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8962 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8963 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8965 call transpose2(EUg(1,1,k),auxmat(1,1))
8966 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8967 vv(1)=pizda(1,1)-pizda(2,2)
8968 vv(2)=pizda(2,1)+pizda(1,2)
8969 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8970 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8972 eello6_graph4=-(s1+s2+s3+s4)
8974 eello6_graph4=-(s2+s3+s4)
8976 C Derivatives in gamma(i-1)
8980 s1=dipderg(2,jj,i)*dip(3,kk,k)
8982 s1=dipderg(4,jj,j)*dip(2,kk,l)
8985 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8987 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8988 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8990 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8991 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8993 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8994 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8995 cd write (2,*) 'turn6 derivatives'
8997 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8999 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9003 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9005 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9009 C Derivatives in gamma(k-1)
9012 s1=dip(3,jj,i)*dipderg(2,kk,k)
9014 s1=dip(2,jj,j)*dipderg(4,kk,l)
9017 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9018 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9020 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
9021 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9023 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
9024 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9026 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9027 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9028 vv(1)=pizda(1,1)-pizda(2,2)
9029 vv(2)=pizda(2,1)+pizda(1,2)
9030 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9031 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9033 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9035 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9039 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9041 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9044 C Derivatives in gamma(j-1) or gamma(l-1)
9045 if (l.eq.j+1 .and. l.gt.1) then
9046 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9047 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9048 call matmat2(AECAderg(1,1,imat),auxmat(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 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9053 else if (j.gt.1) then
9054 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9055 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9056 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9057 vv(1)=pizda(1,1)-pizda(2,2)
9058 vv(2)=pizda(2,1)+pizda(1,2)
9059 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9060 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9061 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9063 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9066 C Cartesian derivatives.
9073 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9075 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9079 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9081 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9085 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9087 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9089 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9090 & b1(1,itj1),auxvec(1))
9091 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
9093 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9094 & b1(1,itl1),auxvec(1))
9095 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
9097 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9099 vv(1)=pizda(1,1)-pizda(2,2)
9100 vv(2)=pizda(2,1)+pizda(1,2)
9101 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9103 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9105 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9108 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9111 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9114 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9116 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9118 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9122 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9124 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9127 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9129 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9137 c----------------------------------------------------------------------------
9138 double precision function eello_turn6(i,jj,kk)
9139 implicit real*8 (a-h,o-z)
9140 include 'DIMENSIONS'
9141 include 'COMMON.IOUNITS'
9142 include 'COMMON.CHAIN'
9143 include 'COMMON.DERIV'
9144 include 'COMMON.INTERACT'
9145 include 'COMMON.CONTACTS'
9146 include 'COMMON.TORSION'
9147 include 'COMMON.VAR'
9148 include 'COMMON.GEO'
9149 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9150 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9152 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9153 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9154 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9155 C the respective energy moment and not to the cluster cumulant.
9164 iti=itortyp(itype(i))
9165 itk=itortyp(itype(k))
9166 itk1=itortyp(itype(k+1))
9167 itl=itortyp(itype(l))
9168 itj=itortyp(itype(j))
9169 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9170 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9171 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9176 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9178 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9182 derx_turn(lll,kkk,iii)=0.0d0
9189 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9191 cd write (2,*) 'eello6_5',eello6_5
9193 call transpose2(AEA(1,1,1),auxmat(1,1))
9194 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9195 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9196 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9198 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9199 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9200 s2 = scalar2(b1(1,itk),vtemp1(1))
9202 call transpose2(AEA(1,1,2),atemp(1,1))
9203 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9204 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9205 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9207 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9208 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9209 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9211 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9212 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9213 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9214 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9215 ss13 = scalar2(b1(1,itk),vtemp4(1))
9216 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9218 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9224 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9225 C Derivatives in gamma(i+2)
9229 call transpose2(AEA(1,1,1),auxmatd(1,1))
9230 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9231 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9232 call transpose2(AEAderg(1,1,2),atempd(1,1))
9233 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9234 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9236 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9237 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9238 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9244 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9245 C Derivatives in gamma(i+3)
9247 call transpose2(AEA(1,1,1),auxmatd(1,1))
9248 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9249 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9250 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9252 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9253 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9254 s2d = scalar2(b1(1,itk),vtemp1d(1))
9256 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9257 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9259 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9261 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9262 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9263 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9271 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9272 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9274 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9275 & -0.5d0*ekont*(s2d+s12d)
9277 C Derivatives in gamma(i+4)
9278 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9279 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9280 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9282 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9283 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9284 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9292 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9294 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9296 C Derivatives in gamma(i+5)
9298 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9299 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9300 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9302 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9303 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9304 s2d = scalar2(b1(1,itk),vtemp1d(1))
9306 call transpose2(AEA(1,1,2),atempd(1,1))
9307 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9308 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9310 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9311 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9313 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9314 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9315 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9323 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9324 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9326 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9327 & -0.5d0*ekont*(s2d+s12d)
9329 C Cartesian derivatives
9334 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9335 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9336 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9338 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9339 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9341 s2d = scalar2(b1(1,itk),vtemp1d(1))
9343 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9344 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9345 s8d = -(atempd(1,1)+atempd(2,2))*
9346 & scalar2(cc(1,1,itl),vtemp2(1))
9348 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9350 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9351 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9358 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9361 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9365 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9366 & - 0.5d0*(s8d+s12d)
9368 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9377 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9379 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9380 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9381 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9382 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9383 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9385 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9386 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9387 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9391 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9392 cd & 16*eel_turn6_num
9394 if (j.lt.nres-1) then
9401 if (l.lt.nres-1) then
9409 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9410 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9411 cgrad ghalf=0.5d0*ggg1(ll)
9413 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9414 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9415 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9416 & +ekont*derx_turn(ll,2,1)
9417 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9418 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9419 & +ekont*derx_turn(ll,4,1)
9420 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9421 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9422 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9423 cgrad ghalf=0.5d0*ggg2(ll)
9425 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9426 & +ekont*derx_turn(ll,2,2)
9427 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9428 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9429 & +ekont*derx_turn(ll,4,2)
9430 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9431 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9432 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9437 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9442 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9448 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9453 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9457 cd write (2,*) iii,g_corr6_loc(iii)
9459 eello_turn6=ekont*eel_turn6
9460 cd write (2,*) 'ekont',ekont
9461 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9465 C-----------------------------------------------------------------------------
9466 double precision function scalar(u,v)
9467 !DIR$ INLINEALWAYS scalar
9469 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9472 double precision u(3),v(3)
9473 cd double precision sc
9481 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9484 crc-------------------------------------------------
9485 SUBROUTINE MATVEC2(A1,V1,V2)
9486 !DIR$ INLINEALWAYS MATVEC2
9488 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9490 implicit real*8 (a-h,o-z)
9491 include 'DIMENSIONS'
9492 DIMENSION A1(2,2),V1(2),V2(2)
9496 c 3 VI=VI+A1(I,K)*V1(K)
9500 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9501 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9506 C---------------------------------------
9507 SUBROUTINE MATMAT2(A1,A2,A3)
9509 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9511 implicit real*8 (a-h,o-z)
9512 include 'DIMENSIONS'
9513 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9514 c DIMENSION AI3(2,2)
9518 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9524 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9525 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9526 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9527 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9535 c-------------------------------------------------------------------------
9536 double precision function scalar2(u,v)
9537 !DIR$ INLINEALWAYS scalar2
9539 double precision u(2),v(2)
9542 scalar2=u(1)*v(1)+u(2)*v(2)
9546 C-----------------------------------------------------------------------------
9548 subroutine transpose2(a,at)
9549 !DIR$ INLINEALWAYS transpose2
9551 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9554 double precision a(2,2),at(2,2)
9561 c--------------------------------------------------------------------------
9562 subroutine transpose(n,a,at)
9565 double precision a(n,n),at(n,n)
9573 C---------------------------------------------------------------------------
9574 subroutine prodmat3(a1,a2,kk,transp,prod)
9575 !DIR$ INLINEALWAYS prodmat3
9577 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9581 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9583 crc double precision auxmat(2,2),prod_(2,2)
9586 crc call transpose2(kk(1,1),auxmat(1,1))
9587 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9588 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9590 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9591 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9592 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9593 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9594 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9595 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9596 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9597 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9600 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9601 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9603 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9604 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9605 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9606 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9607 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9608 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9609 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9610 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9613 c call transpose2(a2(1,1),a2t(1,1))
9616 crc print *,((prod_(i,j),i=1,2),j=1,2)
9617 crc print *,((prod(i,j),i=1,2),j=1,2)