1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
27 include 'COMMON.SPLITELE'
29 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
30 c & " nfgtasks",nfgtasks
31 if (nfgtasks.gt.1) then
33 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
34 if (fg_rank.eq.0) then
35 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
36 c print *,"Processor",myrank," BROADCAST iorder"
37 C FG master sets up the WEIGHTS_ array which will be broadcast to the
38 C FG slaves as WEIGHTS array.
58 C FG Master broadcasts the WEIGHTS_ array
59 call MPI_Bcast(weights_(1),n_ene,
60 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
62 C FG slaves receive the WEIGHTS array
63 call MPI_Bcast(weights(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
85 time_Bcast=time_Bcast+MPI_Wtime()-time00
86 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
87 c call chainbuild_cart
89 c print *,'Processor',myrank,' calling etotal ipot=',ipot
90 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
92 c if (modecalc.eq.12.or.modecalc.eq.14) then
93 c call int_from_cart1(.false.)
100 C Compute the side-chain and electrostatic interaction energy
102 goto (101,102,103,104,105,106) ipot
103 C Lennard-Jones potential.
105 cd print '(a)','Exit ELJ'
107 C Lennard-Jones-Kihara potential (shifted).
110 C Berne-Pechukas potential (dilated LJ, angular dependence).
113 C Gay-Berne potential (shifted LJ, angular dependence).
116 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
119 C Soft-sphere potential
120 106 call e_softsphere(evdw)
122 C Calculate electrostatic (H-bonding) energy of the main chain.
125 c print *,"Processor",myrank," computed USCSC"
131 time_vec=time_vec+MPI_Wtime()-time01
133 c print *,"Processor",myrank," left VEC_AND_DERIV"
136 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
137 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
138 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
139 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
141 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
142 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
143 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
144 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
146 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
155 c write (iout,*) "Soft-spheer ELEC potential"
156 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
159 c print *,"Processor",myrank," computed UELEC"
161 C Calculate excluded-volume interaction energy between peptide groups
166 call escp(evdw2,evdw2_14)
172 c write (iout,*) "Soft-sphere SCP potential"
173 call escp_soft_sphere(evdw2,evdw2_14)
176 c Calculate the bond-stretching energy
180 C Calculate the disulfide-bridge and other energy and the contributions
181 C from other distance constraints.
182 cd print *,'Calling EHPB'
184 cd print *,'EHPB exitted succesfully.'
186 C Calculate the virtual-bond-angle energy.
188 if (wang.gt.0d0) then
193 c print *,"Processor",myrank," computed UB"
195 C Calculate the SC local energy.
198 c print *,"Processor",myrank," computed USC"
200 C Calculate the virtual-bond torsional energy.
202 cd print *,'nterm=',nterm
204 call etor(etors,edihcnstr)
209 c print *,"Processor",myrank," computed Utor"
211 C 6/23/01 Calculate double-torsional energy
213 if (wtor_d.gt.0) then
218 c print *,"Processor",myrank," computed Utord"
220 C 21/5/07 Calculate local sicdechain correlation energy
222 if (wsccor.gt.0.0d0) then
223 call eback_sc_corr(esccor)
227 c print *,"Processor",myrank," computed Usccorr"
229 C 12/1/95 Multi-body terms
233 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
234 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
235 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
236 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
237 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
244 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
245 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
246 cd write (iout,*) "multibody_hb ecorr",ecorr
248 c print *,"Processor",myrank," computed Ucorr"
250 C If performing constraint dynamics, call the constraint energy
251 C after the equilibration time
252 if(usampl.and.totT.gt.eq_time) then
260 time_enecalc=time_enecalc+MPI_Wtime()-time00
262 c print *,"Processor",myrank," computed Uconstr"
271 energia(2)=evdw2-evdw2_14
288 energia(8)=eello_turn3
289 energia(9)=eello_turn4
296 energia(19)=edihcnstr
298 energia(20)=Uconst+Uconst_back
300 c Here are the energies showed per procesor if the are more processors
301 c per molecule then we sum it up in sum_energy subroutine
302 c print *," Processor",myrank," calls SUM_ENERGY"
303 call sum_energy(energia,.true.)
304 c print *," Processor",myrank," left SUM_ENERGY"
306 time_sumene=time_sumene+MPI_Wtime()-time00
310 c-------------------------------------------------------------------------------
311 subroutine sum_energy(energia,reduce)
312 implicit real*8 (a-h,o-z)
317 cMS$ATTRIBUTES C :: proc_proc
323 include 'COMMON.SETUP'
324 include 'COMMON.IOUNITS'
325 double precision energia(0:n_ene),enebuff(0:n_ene+1)
326 include 'COMMON.FFIELD'
327 include 'COMMON.DERIV'
328 include 'COMMON.INTERACT'
329 include 'COMMON.SBRIDGE'
330 include 'COMMON.CHAIN'
332 include 'COMMON.CONTROL'
333 include 'COMMON.TIME1'
336 if (nfgtasks.gt.1 .and. reduce) then
338 write (iout,*) "energies before REDUCE"
339 call enerprint(energia)
343 enebuff(i)=energia(i)
346 call MPI_Barrier(FG_COMM,IERR)
347 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
349 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
350 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
352 write (iout,*) "energies after REDUCE"
353 call enerprint(energia)
356 time_Reduce=time_Reduce+MPI_Wtime()-time00
358 if (fg_rank.eq.0) then
362 evdw2=energia(2)+energia(18)
378 eello_turn3=energia(8)
379 eello_turn4=energia(9)
386 edihcnstr=energia(19)
391 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
392 & +wang*ebe+wtor*etors+wscloc*escloc
393 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
394 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
395 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
396 & +wbond*estr+Uconst+wsccor*esccor
398 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
399 & +wang*ebe+wtor*etors+wscloc*escloc
400 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
401 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
402 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
403 & +wbond*estr+Uconst+wsccor*esccor
409 if (isnan(etot).ne.0) energia(0)=1.0d+99
411 if (isnan(etot)) energia(0)=1.0d+99
416 idumm=proc_proc(etot,i)
418 call proc_proc(etot,i)
420 if(i.eq.1)energia(0)=1.0d+99
427 c-------------------------------------------------------------------------------
428 subroutine sum_gradient
429 implicit real*8 (a-h,o-z)
434 cMS$ATTRIBUTES C :: proc_proc
439 double precision gradbufc(3,maxres),gradbufx(3,maxres),
440 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
442 include 'COMMON.SETUP'
443 include 'COMMON.IOUNITS'
444 include 'COMMON.FFIELD'
445 include 'COMMON.DERIV'
446 include 'COMMON.INTERACT'
447 include 'COMMON.SBRIDGE'
448 include 'COMMON.CHAIN'
450 include 'COMMON.CONTROL'
451 include 'COMMON.TIME1'
452 include 'COMMON.MAXGRAD'
453 include 'COMMON.SCCOR'
458 write (iout,*) "sum_gradient gvdwc, gvdwx"
460 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
461 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
466 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
467 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
468 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
471 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
472 C in virtual-bond-vector coordinates
475 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
477 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
478 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
480 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
482 c write (iout,'(i5,3f10.5,2x,f10.5)')
483 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
485 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
487 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
488 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
496 gradbufc(j,i)=wsc*gvdwc(j,i)+
497 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
498 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
499 & wel_loc*gel_loc_long(j,i)+
500 & wcorr*gradcorr_long(j,i)+
501 & wcorr5*gradcorr5_long(j,i)+
502 & wcorr6*gradcorr6_long(j,i)+
503 & wturn6*gcorr6_turn_long(j,i)+
510 gradbufc(j,i)=wsc*gvdwc(j,i)+
511 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
512 & welec*gelc_long(j,i)+
514 & wel_loc*gel_loc_long(j,i)+
515 & wcorr*gradcorr_long(j,i)+
516 & wcorr5*gradcorr5_long(j,i)+
517 & wcorr6*gradcorr6_long(j,i)+
518 & wturn6*gcorr6_turn_long(j,i)+
524 if (nfgtasks.gt.1) then
527 write (iout,*) "gradbufc before allreduce"
529 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
535 gradbufc_sum(j,i)=gradbufc(j,i)
538 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
539 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
540 c time_reduce=time_reduce+MPI_Wtime()-time00
542 c write (iout,*) "gradbufc_sum after allreduce"
544 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
549 c time_allreduce=time_allreduce+MPI_Wtime()-time00
557 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
558 write (iout,*) (i," jgrad_start",jgrad_start(i),
559 & " jgrad_end ",jgrad_end(i),
560 & i=igrad_start,igrad_end)
563 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
564 c do not parallelize this part.
566 c do i=igrad_start,igrad_end
567 c do j=jgrad_start(i),jgrad_end(i)
569 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
574 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
578 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
582 write (iout,*) "gradbufc after summing"
584 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
591 write (iout,*) "gradbufc"
593 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
599 gradbufc_sum(j,i)=gradbufc(j,i)
604 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
608 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
613 c gradbufc(k,i)=0.0d0
617 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
622 write (iout,*) "gradbufc after summing"
624 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
632 gradbufc(k,nres)=0.0d0
637 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
638 & wel_loc*gel_loc(j,i)+
639 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
640 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
641 & wel_loc*gel_loc_long(j,i)+
642 & wcorr*gradcorr_long(j,i)+
643 & wcorr5*gradcorr5_long(j,i)+
644 & wcorr6*gradcorr6_long(j,i)+
645 & wturn6*gcorr6_turn_long(j,i))+
647 & wcorr*gradcorr(j,i)+
648 & wturn3*gcorr3_turn(j,i)+
649 & wturn4*gcorr4_turn(j,i)+
650 & wcorr5*gradcorr5(j,i)+
651 & wcorr6*gradcorr6(j,i)+
652 & wturn6*gcorr6_turn(j,i)+
653 & wsccor*gsccorc(j,i)
654 & +wscloc*gscloc(j,i)
656 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
657 & wel_loc*gel_loc(j,i)+
658 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
659 & welec*gelc_long(j,i)
660 & wel_loc*gel_loc_long(j,i)+
661 & wcorr*gcorr_long(j,i)+
662 & wcorr5*gradcorr5_long(j,i)+
663 & wcorr6*gradcorr6_long(j,i)+
664 & wturn6*gcorr6_turn_long(j,i))+
666 & wcorr*gradcorr(j,i)+
667 & wturn3*gcorr3_turn(j,i)+
668 & wturn4*gcorr4_turn(j,i)+
669 & wcorr5*gradcorr5(j,i)+
670 & wcorr6*gradcorr6(j,i)+
671 & wturn6*gcorr6_turn(j,i)+
672 & wsccor*gsccorc(j,i)
673 & +wscloc*gscloc(j,i)
675 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
677 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
678 & wsccor*gsccorx(j,i)
679 & +wscloc*gsclocx(j,i)
683 write (iout,*) "gloc before adding corr"
685 write (iout,*) i,gloc(i,icg)
689 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
690 & +wcorr5*g_corr5_loc(i)
691 & +wcorr6*g_corr6_loc(i)
692 & +wturn4*gel_loc_turn4(i)
693 & +wturn3*gel_loc_turn3(i)
694 & +wturn6*gel_loc_turn6(i)
695 & +wel_loc*gel_loc_loc(i)
698 write (iout,*) "gloc after adding corr"
700 write (iout,*) i,gloc(i,icg)
704 if (nfgtasks.gt.1) then
707 gradbufc(j,i)=gradc(j,i,icg)
708 gradbufx(j,i)=gradx(j,i,icg)
712 glocbuf(i)=gloc(i,icg)
716 write (iout,*) "gloc_sc before reduce"
719 write (iout,*) i,j,gloc_sc(j,i,icg)
726 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
730 call MPI_Barrier(FG_COMM,IERR)
731 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
733 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
734 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
735 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
736 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
737 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
738 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
739 time_reduce=time_reduce+MPI_Wtime()-time00
740 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
741 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
742 time_reduce=time_reduce+MPI_Wtime()-time00
745 write (iout,*) "gloc_sc after reduce"
748 write (iout,*) i,j,gloc_sc(j,i,icg)
754 write (iout,*) "gloc after reduce"
756 write (iout,*) i,gloc(i,icg)
761 if (gnorm_check) then
763 c Compute the maximum elements of the gradient
773 gcorr3_turn_max=0.0d0
774 gcorr4_turn_max=0.0d0
777 gcorr6_turn_max=0.0d0
787 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
788 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
789 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
790 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
791 & gvdwc_scp_max=gvdwc_scp_norm
792 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
793 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
794 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
795 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
796 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
797 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
798 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
799 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
800 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
801 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
802 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
803 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
804 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
806 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
807 & gcorr3_turn_max=gcorr3_turn_norm
808 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
810 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
811 & gcorr4_turn_max=gcorr4_turn_norm
812 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
813 if (gradcorr5_norm.gt.gradcorr5_max)
814 & gradcorr5_max=gradcorr5_norm
815 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
816 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
817 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
819 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
820 & gcorr6_turn_max=gcorr6_turn_norm
821 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
822 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
823 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
824 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
825 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
826 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
827 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
828 if (gradx_scp_norm.gt.gradx_scp_max)
829 & gradx_scp_max=gradx_scp_norm
830 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
831 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
832 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
833 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
834 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
835 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
836 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
837 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
841 open(istat,file=statname,position="append")
843 open(istat,file=statname,access="append")
845 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
846 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
847 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
848 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
849 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
850 & gsccorx_max,gsclocx_max
852 if (gvdwc_max.gt.1.0d4) then
853 write (iout,*) "gvdwc gvdwx gradb gradbx"
855 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
856 & gradb(j,i),gradbx(j,i),j=1,3)
858 call pdbout(0.0d0,'cipiszcze',iout)
864 write (iout,*) "gradc gradx gloc"
866 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
867 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
871 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
875 c-------------------------------------------------------------------------------
876 subroutine rescale_weights(t_bath)
877 implicit real*8 (a-h,o-z)
879 include 'COMMON.IOUNITS'
880 include 'COMMON.FFIELD'
881 include 'COMMON.SBRIDGE'
882 double precision kfac /2.4d0/
883 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
885 c facT=2*temp0/(t_bath+temp0)
886 if (rescale_mode.eq.0) then
892 else if (rescale_mode.eq.1) then
893 facT=kfac/(kfac-1.0d0+t_bath/temp0)
894 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
895 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
896 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
897 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
898 else if (rescale_mode.eq.2) then
904 facT=licznik/dlog(dexp(x)+dexp(-x))
905 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
906 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
907 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
908 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
910 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
911 write (*,*) "Wrong RESCALE_MODE",rescale_mode
913 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
917 welec=weights(3)*fact
918 wcorr=weights(4)*fact3
919 wcorr5=weights(5)*fact4
920 wcorr6=weights(6)*fact5
921 wel_loc=weights(7)*fact2
922 wturn3=weights(8)*fact2
923 wturn4=weights(9)*fact3
924 wturn6=weights(10)*fact5
925 wtor=weights(13)*fact
926 wtor_d=weights(14)*fact2
927 wsccor=weights(21)*fact
931 C------------------------------------------------------------------------
932 subroutine enerprint(energia)
933 implicit real*8 (a-h,o-z)
935 include 'COMMON.IOUNITS'
936 include 'COMMON.FFIELD'
937 include 'COMMON.SBRIDGE'
939 double precision energia(0:n_ene)
944 evdw2=energia(2)+energia(18)
956 eello_turn3=energia(8)
957 eello_turn4=energia(9)
958 eello_turn6=energia(10)
964 edihcnstr=energia(19)
969 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
970 & estr,wbond,ebe,wang,
971 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
973 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
974 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
977 10 format (/'Virtual-chain energies:'//
978 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
979 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
980 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
981 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
982 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
983 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
984 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
985 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
986 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
987 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
988 & ' (SS bridges & dist. cnstr.)'/
989 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
990 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
991 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
992 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
993 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
994 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
995 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
996 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
997 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
998 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
999 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1000 & 'ETOT= ',1pE16.6,' (total)')
1002 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1003 & estr,wbond,ebe,wang,
1004 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1006 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1007 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1008 & ebr*nss,Uconst,etot
1009 10 format (/'Virtual-chain energies:'//
1010 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1011 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1012 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1013 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1014 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1015 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1016 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1017 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1018 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1019 & ' (SS bridges & dist. cnstr.)'/
1020 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1021 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1022 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1023 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1024 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1025 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1026 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1027 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1028 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1029 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1030 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1031 & 'ETOT= ',1pE16.6,' (total)')
1035 C-----------------------------------------------------------------------
1036 subroutine elj(evdw)
1038 C This subroutine calculates the interaction energy of nonbonded side chains
1039 C assuming the LJ potential of interaction.
1041 implicit real*8 (a-h,o-z)
1042 include 'DIMENSIONS'
1043 parameter (accur=1.0d-10)
1044 include 'COMMON.GEO'
1045 include 'COMMON.VAR'
1046 include 'COMMON.LOCAL'
1047 include 'COMMON.CHAIN'
1048 include 'COMMON.DERIV'
1049 include 'COMMON.INTERACT'
1050 include 'COMMON.TORSION'
1051 include 'COMMON.SBRIDGE'
1052 include 'COMMON.NAMES'
1053 include 'COMMON.IOUNITS'
1054 include 'COMMON.CONTACTS'
1056 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1058 do i=iatsc_s,iatsc_e
1059 itypi=iabs(itype(i))
1060 if (itypi.eq.ntyp1) cycle
1061 itypi1=iabs(itype(i+1))
1068 C Calculate SC interaction energy.
1070 do iint=1,nint_gr(i)
1071 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1072 cd & 'iend=',iend(i,iint)
1073 do j=istart(i,iint),iend(i,iint)
1074 itypj=iabs(itype(j))
1075 if (itypj.eq.ntyp1) cycle
1079 C Change 12/1/95 to calculate four-body interactions
1080 rij=xj*xj+yj*yj+zj*zj
1082 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1083 eps0ij=eps(itypi,itypj)
1085 e1=fac*fac*aa(itypi,itypj)
1086 e2=fac*bb(itypi,itypj)
1088 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1089 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1090 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1091 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1092 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1093 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1096 C Calculate the components of the gradient in DC and X
1098 fac=-rrij*(e1+evdwij)
1103 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1104 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1105 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1106 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1110 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1114 C 12/1/95, revised on 5/20/97
1116 C Calculate the contact function. The ith column of the array JCONT will
1117 C contain the numbers of atoms that make contacts with the atom I (of numbers
1118 C greater than I). The arrays FACONT and GACONT will contain the values of
1119 C the contact function and its derivative.
1121 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1122 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1123 C Uncomment next line, if the correlation interactions are contact function only
1124 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1126 sigij=sigma(itypi,itypj)
1127 r0ij=rs0(itypi,itypj)
1129 C Check whether the SC's are not too far to make a contact.
1132 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1133 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1135 if (fcont.gt.0.0D0) then
1136 C If the SC-SC distance if close to sigma, apply spline.
1137 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1138 cAdam & fcont1,fprimcont1)
1139 cAdam fcont1=1.0d0-fcont1
1140 cAdam if (fcont1.gt.0.0d0) then
1141 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1142 cAdam fcont=fcont*fcont1
1144 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1145 cga eps0ij=1.0d0/dsqrt(eps0ij)
1147 cga gg(k)=gg(k)*eps0ij
1149 cga eps0ij=-evdwij*eps0ij
1150 C Uncomment for AL's type of SC correlation interactions.
1151 cadam eps0ij=-evdwij
1152 num_conti=num_conti+1
1153 jcont(num_conti,i)=j
1154 facont(num_conti,i)=fcont*eps0ij
1155 fprimcont=eps0ij*fprimcont/rij
1157 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1158 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1159 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1160 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1161 gacont(1,num_conti,i)=-fprimcont*xj
1162 gacont(2,num_conti,i)=-fprimcont*yj
1163 gacont(3,num_conti,i)=-fprimcont*zj
1164 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1165 cd write (iout,'(2i3,3f10.5)')
1166 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1172 num_cont(i)=num_conti
1176 gvdwc(j,i)=expon*gvdwc(j,i)
1177 gvdwx(j,i)=expon*gvdwx(j,i)
1180 C******************************************************************************
1184 C To save time, the factor of EXPON has been extracted from ALL components
1185 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1188 C******************************************************************************
1191 C-----------------------------------------------------------------------------
1192 subroutine eljk(evdw)
1194 C This subroutine calculates the interaction energy of nonbonded side chains
1195 C assuming the LJK potential of interaction.
1197 implicit real*8 (a-h,o-z)
1198 include 'DIMENSIONS'
1199 include 'COMMON.GEO'
1200 include 'COMMON.VAR'
1201 include 'COMMON.LOCAL'
1202 include 'COMMON.CHAIN'
1203 include 'COMMON.DERIV'
1204 include 'COMMON.INTERACT'
1205 include 'COMMON.IOUNITS'
1206 include 'COMMON.NAMES'
1209 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1211 do i=iatsc_s,iatsc_e
1212 itypi=iabs(itype(i))
1213 if (itypi.eq.ntyp1) cycle
1214 itypi1=iabs(itype(i+1))
1219 C Calculate SC interaction energy.
1221 do iint=1,nint_gr(i)
1222 do j=istart(i,iint),iend(i,iint)
1223 itypj=iabs(itype(j))
1224 if (itypj.eq.ntyp1) cycle
1228 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1229 fac_augm=rrij**expon
1230 e_augm=augm(itypi,itypj)*fac_augm
1231 r_inv_ij=dsqrt(rrij)
1233 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1234 fac=r_shift_inv**expon
1235 e1=fac*fac*aa(itypi,itypj)
1236 e2=fac*bb(itypi,itypj)
1238 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1239 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1240 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1241 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1242 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1243 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1244 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1247 C Calculate the components of the gradient in DC and X
1249 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1254 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1255 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1256 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1257 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1261 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1269 gvdwc(j,i)=expon*gvdwc(j,i)
1270 gvdwx(j,i)=expon*gvdwx(j,i)
1275 C-----------------------------------------------------------------------------
1276 subroutine ebp(evdw)
1278 C This subroutine calculates the interaction energy of nonbonded side chains
1279 C assuming the Berne-Pechukas potential of interaction.
1281 implicit real*8 (a-h,o-z)
1282 include 'DIMENSIONS'
1283 include 'COMMON.GEO'
1284 include 'COMMON.VAR'
1285 include 'COMMON.LOCAL'
1286 include 'COMMON.CHAIN'
1287 include 'COMMON.DERIV'
1288 include 'COMMON.NAMES'
1289 include 'COMMON.INTERACT'
1290 include 'COMMON.IOUNITS'
1291 include 'COMMON.CALC'
1292 common /srutu/ icall
1293 c double precision rrsave(maxdim)
1296 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1298 c if (icall.eq.0) then
1304 do i=iatsc_s,iatsc_e
1305 itypi=iabs(itype(i))
1306 if (itypi.eq.ntyp1) cycle
1307 itypi1=iabs(itype(i+1))
1311 dxi=dc_norm(1,nres+i)
1312 dyi=dc_norm(2,nres+i)
1313 dzi=dc_norm(3,nres+i)
1314 c dsci_inv=dsc_inv(itypi)
1315 dsci_inv=vbld_inv(i+nres)
1317 C Calculate SC interaction energy.
1319 do iint=1,nint_gr(i)
1320 do j=istart(i,iint),iend(i,iint)
1322 itypj=iabs(itype(j))
1323 if (itypj.eq.ntyp1) cycle
1324 c dscj_inv=dsc_inv(itypj)
1325 dscj_inv=vbld_inv(j+nres)
1326 chi1=chi(itypi,itypj)
1327 chi2=chi(itypj,itypi)
1334 alf12=0.5D0*(alf1+alf2)
1335 C For diagnostics only!!!
1348 dxj=dc_norm(1,nres+j)
1349 dyj=dc_norm(2,nres+j)
1350 dzj=dc_norm(3,nres+j)
1351 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1352 cd if (icall.eq.0) then
1358 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1360 C Calculate whole angle-dependent part of epsilon and contributions
1361 C to its derivatives
1362 fac=(rrij*sigsq)**expon2
1363 e1=fac*fac*aa(itypi,itypj)
1364 e2=fac*bb(itypi,itypj)
1365 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1366 eps2der=evdwij*eps3rt
1367 eps3der=evdwij*eps2rt
1368 evdwij=evdwij*eps2rt*eps3rt
1371 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1372 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1373 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1374 cd & restyp(itypi),i,restyp(itypj),j,
1375 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1376 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1377 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1380 C Calculate gradient components.
1381 e1=e1*eps1*eps2rt**2*eps3rt**2
1382 fac=-expon*(e1+evdwij)
1385 C Calculate radial part of the gradient
1389 C Calculate the angular part of the gradient and sum add the contributions
1390 C to the appropriate components of the Cartesian gradient.
1398 C-----------------------------------------------------------------------------
1399 subroutine egb(evdw)
1401 C This subroutine calculates the interaction energy of nonbonded side chains
1402 C assuming the Gay-Berne potential of interaction.
1404 implicit real*8 (a-h,o-z)
1405 include 'DIMENSIONS'
1406 include 'COMMON.GEO'
1407 include 'COMMON.VAR'
1408 include 'COMMON.LOCAL'
1409 include 'COMMON.CHAIN'
1410 include 'COMMON.DERIV'
1411 include 'COMMON.NAMES'
1412 include 'COMMON.INTERACT'
1413 include 'COMMON.IOUNITS'
1414 include 'COMMON.CALC'
1415 include 'COMMON.CONTROL'
1416 include 'COMMON.SPLITELE'
1418 integer xshift,yshift,zshift
1420 ccccc energy_dec=.false.
1421 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1424 c if (icall.eq.0) lprn=.false.
1426 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1427 C we have the original box)
1431 do i=iatsc_s,iatsc_e
1432 itypi=iabs(itype(i))
1433 if (itypi.eq.ntyp1) cycle
1434 itypi1=iabs(itype(i+1))
1438 C Return atom into box, boxxsize is size of box in x dimension
1440 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1441 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1442 C Condition for being inside the proper box
1443 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1444 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1448 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1449 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1450 C Condition for being inside the proper box
1451 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1452 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1456 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1457 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1458 C Condition for being inside the proper box
1459 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1460 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1464 if (xi.lt.0) xi=xi+boxxsize
1466 if (yi.lt.0) yi=yi+boxysize
1468 if (zi.lt.0) zi=zi+boxzsize
1469 xi=xi+xshift*boxxsize
1470 yi=yi+yshift*boxysize
1471 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 dxj=dc_norm(1,nres+j)
1548 dyj=dc_norm(2,nres+j)
1549 dzj=dc_norm(3,nres+j)
1553 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1554 c write (iout,*) "j",j," dc_norm",
1555 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1556 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1558 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1559 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1561 c write (iout,'(a7,4f8.3)')
1562 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1563 if (sss.gt.0.0d0) then
1564 C Calculate angle-dependent terms of energy and contributions to their
1568 sig=sig0ij*dsqrt(sigsq)
1569 rij_shift=1.0D0/rij-sig+sig0ij
1570 c for diagnostics; uncomment
1571 c rij_shift=1.2*sig0ij
1572 C I hate to put IF's in the loops, but here don't have another choice!!!!
1573 if (rij_shift.le.0.0D0) then
1575 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1576 cd & restyp(itypi),i,restyp(itypj),j,
1577 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1581 c---------------------------------------------------------------
1582 rij_shift=1.0D0/rij_shift
1583 fac=rij_shift**expon
1584 e1=fac*fac*aa(itypi,itypj)
1585 e2=fac*bb(itypi,itypj)
1586 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1587 eps2der=evdwij*eps3rt
1588 eps3der=evdwij*eps2rt
1589 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1590 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1591 evdwij=evdwij*eps2rt*eps3rt
1592 evdw=evdw+evdwij*sss
1594 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1595 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1596 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1597 & restyp(itypi),i,restyp(itypj),j,
1598 & epsi,sigm,chi1,chi2,chip1,chip2,
1599 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1600 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1604 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1607 C Calculate gradient components.
1608 e1=e1*eps1*eps2rt**2*eps3rt**2
1609 fac=-expon*(e1+evdwij)*rij_shift
1612 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1613 c & evdwij,fac,sigma(itypi,itypj),expon
1614 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1616 C Calculate the radial part of the gradient
1620 C Calculate angular part of the gradient.
1629 c write (iout,*) "Number of loop steps in EGB:",ind
1630 cccc energy_dec=.false.
1633 C-----------------------------------------------------------------------------
1634 subroutine egbv(evdw)
1636 C This subroutine calculates the interaction energy of nonbonded side chains
1637 C assuming the Gay-Berne-Vorobjev potential of interaction.
1639 implicit real*8 (a-h,o-z)
1640 include 'DIMENSIONS'
1641 include 'COMMON.GEO'
1642 include 'COMMON.VAR'
1643 include 'COMMON.LOCAL'
1644 include 'COMMON.CHAIN'
1645 include 'COMMON.DERIV'
1646 include 'COMMON.NAMES'
1647 include 'COMMON.INTERACT'
1648 include 'COMMON.IOUNITS'
1649 include 'COMMON.CALC'
1650 common /srutu/ icall
1653 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1656 c if (icall.eq.0) lprn=.true.
1658 do i=iatsc_s,iatsc_e
1659 itypi=iabs(itype(i))
1660 if (itypi.eq.ntyp1) cycle
1661 itypi1=iabs(itype(i+1))
1665 dxi=dc_norm(1,nres+i)
1666 dyi=dc_norm(2,nres+i)
1667 dzi=dc_norm(3,nres+i)
1668 c dsci_inv=dsc_inv(itypi)
1669 dsci_inv=vbld_inv(i+nres)
1671 C Calculate SC interaction energy.
1673 do iint=1,nint_gr(i)
1674 do j=istart(i,iint),iend(i,iint)
1676 itypj=iabs(itype(j))
1677 if (itypj.eq.ntyp1) cycle
1678 c dscj_inv=dsc_inv(itypj)
1679 dscj_inv=vbld_inv(j+nres)
1680 sig0ij=sigma(itypi,itypj)
1681 r0ij=r0(itypi,itypj)
1682 chi1=chi(itypi,itypj)
1683 chi2=chi(itypj,itypi)
1690 alf12=0.5D0*(alf1+alf2)
1691 C For diagnostics only!!!
1704 dxj=dc_norm(1,nres+j)
1705 dyj=dc_norm(2,nres+j)
1706 dzj=dc_norm(3,nres+j)
1707 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1709 C Calculate angle-dependent terms of energy and contributions to their
1713 sig=sig0ij*dsqrt(sigsq)
1714 rij_shift=1.0D0/rij-sig+r0ij
1715 C I hate to put IF's in the loops, but here don't have another choice!!!!
1716 if (rij_shift.le.0.0D0) then
1721 c---------------------------------------------------------------
1722 rij_shift=1.0D0/rij_shift
1723 fac=rij_shift**expon
1724 e1=fac*fac*aa(itypi,itypj)
1725 e2=fac*bb(itypi,itypj)
1726 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1727 eps2der=evdwij*eps3rt
1728 eps3der=evdwij*eps2rt
1729 fac_augm=rrij**expon
1730 e_augm=augm(itypi,itypj)*fac_augm
1731 evdwij=evdwij*eps2rt*eps3rt
1732 evdw=evdw+evdwij+e_augm
1734 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1735 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1736 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1737 & restyp(itypi),i,restyp(itypj),j,
1738 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1739 & chi1,chi2,chip1,chip2,
1740 & eps1,eps2rt**2,eps3rt**2,
1741 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1744 C Calculate gradient components.
1745 e1=e1*eps1*eps2rt**2*eps3rt**2
1746 fac=-expon*(e1+evdwij)*rij_shift
1748 fac=rij*fac-2*expon*rrij*e_augm
1749 C Calculate the radial part of the gradient
1753 C Calculate angular part of the gradient.
1759 C-----------------------------------------------------------------------------
1760 subroutine sc_angular
1761 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1762 C om12. Called by ebp, egb, and egbv.
1764 include 'COMMON.CALC'
1765 include 'COMMON.IOUNITS'
1769 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1770 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1771 om12=dxi*dxj+dyi*dyj+dzi*dzj
1773 C Calculate eps1(om12) and its derivative in om12
1774 faceps1=1.0D0-om12*chiom12
1775 faceps1_inv=1.0D0/faceps1
1776 eps1=dsqrt(faceps1_inv)
1777 C Following variable is eps1*deps1/dom12
1778 eps1_om12=faceps1_inv*chiom12
1783 c write (iout,*) "om12",om12," eps1",eps1
1784 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1789 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1790 sigsq=1.0D0-facsig*faceps1_inv
1791 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1792 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1793 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1799 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1800 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1802 C Calculate eps2 and its derivatives in om1, om2, and om12.
1805 chipom12=chip12*om12
1806 facp=1.0D0-om12*chipom12
1808 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1809 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1810 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1811 C Following variable is the square root of eps2
1812 eps2rt=1.0D0-facp1*facp_inv
1813 C Following three variables are the derivatives of the square root of eps
1814 C in om1, om2, and om12.
1815 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1816 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1817 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1818 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1819 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1820 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1821 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1822 c & " eps2rt_om12",eps2rt_om12
1823 C Calculate whole angle-dependent part of epsilon and contributions
1824 C to its derivatives
1827 C----------------------------------------------------------------------------
1829 implicit real*8 (a-h,o-z)
1830 include 'DIMENSIONS'
1831 include 'COMMON.CHAIN'
1832 include 'COMMON.DERIV'
1833 include 'COMMON.CALC'
1834 include 'COMMON.IOUNITS'
1835 double precision dcosom1(3),dcosom2(3)
1836 cc print *,'sss=',sss
1837 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1838 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1839 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1840 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1844 c eom12=evdwij*eps1_om12
1846 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1847 c & " sigder",sigder
1848 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1849 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1851 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1852 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1855 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
1857 c write (iout,*) "gg",(gg(k),k=1,3)
1859 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1860 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1861 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
1862 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1863 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1864 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
1865 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1866 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1867 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1868 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1871 C Calculate the components of the gradient in DC and X
1875 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1879 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1880 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1884 C-----------------------------------------------------------------------
1885 subroutine e_softsphere(evdw)
1887 C This subroutine calculates the interaction energy of nonbonded side chains
1888 C assuming the LJ potential of interaction.
1890 implicit real*8 (a-h,o-z)
1891 include 'DIMENSIONS'
1892 parameter (accur=1.0d-10)
1893 include 'COMMON.GEO'
1894 include 'COMMON.VAR'
1895 include 'COMMON.LOCAL'
1896 include 'COMMON.CHAIN'
1897 include 'COMMON.DERIV'
1898 include 'COMMON.INTERACT'
1899 include 'COMMON.TORSION'
1900 include 'COMMON.SBRIDGE'
1901 include 'COMMON.NAMES'
1902 include 'COMMON.IOUNITS'
1903 include 'COMMON.CONTACTS'
1905 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1907 do i=iatsc_s,iatsc_e
1908 itypi=iabs(itype(i))
1909 if (itypi.eq.ntyp1) cycle
1910 itypi1=iabs(itype(i+1))
1915 C Calculate SC interaction energy.
1917 do iint=1,nint_gr(i)
1918 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1919 cd & 'iend=',iend(i,iint)
1920 do j=istart(i,iint),iend(i,iint)
1921 itypj=iabs(itype(j))
1922 if (itypj.eq.ntyp1) cycle
1926 rij=xj*xj+yj*yj+zj*zj
1927 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1928 r0ij=r0(itypi,itypj)
1930 c print *,i,j,r0ij,dsqrt(rij)
1931 if (rij.lt.r0ijsq) then
1932 evdwij=0.25d0*(rij-r0ijsq)**2
1940 C Calculate the components of the gradient in DC and X
1946 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1947 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1948 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1949 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1953 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1961 C--------------------------------------------------------------------------
1962 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1965 C Soft-sphere potential of p-p interaction
1967 implicit real*8 (a-h,o-z)
1968 include 'DIMENSIONS'
1969 include 'COMMON.CONTROL'
1970 include 'COMMON.IOUNITS'
1971 include 'COMMON.GEO'
1972 include 'COMMON.VAR'
1973 include 'COMMON.LOCAL'
1974 include 'COMMON.CHAIN'
1975 include 'COMMON.DERIV'
1976 include 'COMMON.INTERACT'
1977 include 'COMMON.CONTACTS'
1978 include 'COMMON.TORSION'
1979 include 'COMMON.VECTORS'
1980 include 'COMMON.FFIELD'
1982 cd write(iout,*) 'In EELEC_soft_sphere'
1989 do i=iatel_s,iatel_e
1990 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1994 xmedi=c(1,i)+0.5d0*dxi
1995 ymedi=c(2,i)+0.5d0*dyi
1996 zmedi=c(3,i)+0.5d0*dzi
1998 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1999 do j=ielstart(i),ielend(i)
2000 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2004 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2005 r0ij=rpp(iteli,itelj)
2010 xj=c(1,j)+0.5D0*dxj-xmedi
2011 yj=c(2,j)+0.5D0*dyj-ymedi
2012 zj=c(3,j)+0.5D0*dzj-zmedi
2013 rij=xj*xj+yj*yj+zj*zj
2014 if (rij.lt.r0ijsq) then
2015 evdw1ij=0.25d0*(rij-r0ijsq)**2
2023 C Calculate contributions to the Cartesian gradient.
2029 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2030 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2033 * Loop over residues i+1 thru j-1.
2037 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2042 cgrad do i=nnt,nct-1
2044 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2046 cgrad do j=i+1,nct-1
2048 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2054 c------------------------------------------------------------------------------
2055 subroutine vec_and_deriv
2056 implicit real*8 (a-h,o-z)
2057 include 'DIMENSIONS'
2061 include 'COMMON.IOUNITS'
2062 include 'COMMON.GEO'
2063 include 'COMMON.VAR'
2064 include 'COMMON.LOCAL'
2065 include 'COMMON.CHAIN'
2066 include 'COMMON.VECTORS'
2067 include 'COMMON.SETUP'
2068 include 'COMMON.TIME1'
2069 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2070 C Compute the local reference systems. For reference system (i), the
2071 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2072 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2074 do i=ivec_start,ivec_end
2078 if (i.eq.nres-1) then
2079 C Case of the last full residue
2080 C Compute the Z-axis
2081 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2082 costh=dcos(pi-theta(nres))
2083 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2087 C Compute the derivatives of uz
2089 uzder(2,1,1)=-dc_norm(3,i-1)
2090 uzder(3,1,1)= dc_norm(2,i-1)
2091 uzder(1,2,1)= dc_norm(3,i-1)
2093 uzder(3,2,1)=-dc_norm(1,i-1)
2094 uzder(1,3,1)=-dc_norm(2,i-1)
2095 uzder(2,3,1)= dc_norm(1,i-1)
2098 uzder(2,1,2)= dc_norm(3,i)
2099 uzder(3,1,2)=-dc_norm(2,i)
2100 uzder(1,2,2)=-dc_norm(3,i)
2102 uzder(3,2,2)= dc_norm(1,i)
2103 uzder(1,3,2)= dc_norm(2,i)
2104 uzder(2,3,2)=-dc_norm(1,i)
2106 C Compute the Y-axis
2109 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2111 C Compute the derivatives of uy
2114 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2115 & -dc_norm(k,i)*dc_norm(j,i-1)
2116 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2118 uyder(j,j,1)=uyder(j,j,1)-costh
2119 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2124 uygrad(l,k,j,i)=uyder(l,k,j)
2125 uzgrad(l,k,j,i)=uzder(l,k,j)
2129 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2130 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2131 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2132 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2135 C Compute the Z-axis
2136 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2137 costh=dcos(pi-theta(i+2))
2138 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2142 C Compute the derivatives of uz
2144 uzder(2,1,1)=-dc_norm(3,i+1)
2145 uzder(3,1,1)= dc_norm(2,i+1)
2146 uzder(1,2,1)= dc_norm(3,i+1)
2148 uzder(3,2,1)=-dc_norm(1,i+1)
2149 uzder(1,3,1)=-dc_norm(2,i+1)
2150 uzder(2,3,1)= dc_norm(1,i+1)
2153 uzder(2,1,2)= dc_norm(3,i)
2154 uzder(3,1,2)=-dc_norm(2,i)
2155 uzder(1,2,2)=-dc_norm(3,i)
2157 uzder(3,2,2)= dc_norm(1,i)
2158 uzder(1,3,2)= dc_norm(2,i)
2159 uzder(2,3,2)=-dc_norm(1,i)
2161 C Compute the Y-axis
2164 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2166 C Compute the derivatives of uy
2169 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2170 & -dc_norm(k,i)*dc_norm(j,i+1)
2171 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2173 uyder(j,j,1)=uyder(j,j,1)-costh
2174 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2179 uygrad(l,k,j,i)=uyder(l,k,j)
2180 uzgrad(l,k,j,i)=uzder(l,k,j)
2184 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2185 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2186 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2187 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2191 vbld_inv_temp(1)=vbld_inv(i+1)
2192 if (i.lt.nres-1) then
2193 vbld_inv_temp(2)=vbld_inv(i+2)
2195 vbld_inv_temp(2)=vbld_inv(i)
2200 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2201 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2206 #if defined(PARVEC) && defined(MPI)
2207 if (nfgtasks1.gt.1) then
2209 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2210 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2211 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2212 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2213 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2215 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2216 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2218 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2219 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2220 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2221 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2222 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2223 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2224 time_gather=time_gather+MPI_Wtime()-time00
2226 c if (fg_rank.eq.0) then
2227 c write (iout,*) "Arrays UY and UZ"
2229 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2236 C-----------------------------------------------------------------------------
2237 subroutine check_vecgrad
2238 implicit real*8 (a-h,o-z)
2239 include 'DIMENSIONS'
2240 include 'COMMON.IOUNITS'
2241 include 'COMMON.GEO'
2242 include 'COMMON.VAR'
2243 include 'COMMON.LOCAL'
2244 include 'COMMON.CHAIN'
2245 include 'COMMON.VECTORS'
2246 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2247 dimension uyt(3,maxres),uzt(3,maxres)
2248 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2249 double precision delta /1.0d-7/
2252 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2253 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2254 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2255 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2256 cd & (dc_norm(if90,i),if90=1,3)
2257 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2258 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2259 cd write(iout,'(a)')
2265 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2266 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2279 cd write (iout,*) 'i=',i
2281 erij(k)=dc_norm(k,i)
2285 dc_norm(k,i)=erij(k)
2287 dc_norm(j,i)=dc_norm(j,i)+delta
2288 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2290 c dc_norm(k,i)=dc_norm(k,i)/fac
2292 c write (iout,*) (dc_norm(k,i),k=1,3)
2293 c write (iout,*) (erij(k),k=1,3)
2296 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2297 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2298 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2299 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2301 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2302 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2303 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2306 dc_norm(k,i)=erij(k)
2309 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2310 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2311 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2312 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2313 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2314 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2315 cd write (iout,'(a)')
2320 C--------------------------------------------------------------------------
2321 subroutine set_matrices
2322 implicit real*8 (a-h,o-z)
2323 include 'DIMENSIONS'
2326 include "COMMON.SETUP"
2328 integer status(MPI_STATUS_SIZE)
2330 include 'COMMON.IOUNITS'
2331 include 'COMMON.GEO'
2332 include 'COMMON.VAR'
2333 include 'COMMON.LOCAL'
2334 include 'COMMON.CHAIN'
2335 include 'COMMON.DERIV'
2336 include 'COMMON.INTERACT'
2337 include 'COMMON.CONTACTS'
2338 include 'COMMON.TORSION'
2339 include 'COMMON.VECTORS'
2340 include 'COMMON.FFIELD'
2341 double precision auxvec(2),auxmat(2,2)
2343 C Compute the virtual-bond-torsional-angle dependent quantities needed
2344 C to calculate the el-loc multibody terms of various order.
2347 do i=ivec_start+2,ivec_end+2
2351 if (i .lt. nres+1) then
2388 if (i .gt. 3 .and. i .lt. nres+1) then
2389 obrot_der(1,i-2)=-sin1
2390 obrot_der(2,i-2)= cos1
2391 Ugder(1,1,i-2)= sin1
2392 Ugder(1,2,i-2)=-cos1
2393 Ugder(2,1,i-2)=-cos1
2394 Ugder(2,2,i-2)=-sin1
2397 obrot2_der(1,i-2)=-dwasin2
2398 obrot2_der(2,i-2)= dwacos2
2399 Ug2der(1,1,i-2)= dwasin2
2400 Ug2der(1,2,i-2)=-dwacos2
2401 Ug2der(2,1,i-2)=-dwacos2
2402 Ug2der(2,2,i-2)=-dwasin2
2404 obrot_der(1,i-2)=0.0d0
2405 obrot_der(2,i-2)=0.0d0
2406 Ugder(1,1,i-2)=0.0d0
2407 Ugder(1,2,i-2)=0.0d0
2408 Ugder(2,1,i-2)=0.0d0
2409 Ugder(2,2,i-2)=0.0d0
2410 obrot2_der(1,i-2)=0.0d0
2411 obrot2_der(2,i-2)=0.0d0
2412 Ug2der(1,1,i-2)=0.0d0
2413 Ug2der(1,2,i-2)=0.0d0
2414 Ug2der(2,1,i-2)=0.0d0
2415 Ug2der(2,2,i-2)=0.0d0
2417 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2418 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2419 iti = itortyp(itype(i-2))
2423 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2424 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2425 iti1 = itortyp(itype(i-1))
2429 cd write (iout,*) '*******i',i,' iti1',iti
2430 cd write (iout,*) 'b1',b1(:,iti)
2431 cd write (iout,*) 'b2',b2(:,iti)
2432 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2433 c if (i .gt. iatel_s+2) then
2434 if (i .gt. nnt+2) then
2435 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2436 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2437 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2439 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2440 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2441 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2442 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2443 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2454 DtUg2(l,k,i-2)=0.0d0
2458 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2459 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2461 muder(k,i-2)=Ub2der(k,i-2)
2463 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2464 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2465 if (itype(i-1).le.ntyp) then
2466 iti1 = itortyp(itype(i-1))
2474 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2476 cd write (iout,*) 'mu ',mu(:,i-2)
2477 cd write (iout,*) 'mu1',mu1(:,i-2)
2478 cd write (iout,*) 'mu2',mu2(:,i-2)
2479 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2481 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2482 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2483 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2484 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2485 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2486 C Vectors and matrices dependent on a single virtual-bond dihedral.
2487 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2488 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2489 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2490 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2491 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2492 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2493 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2494 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2495 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2498 C Matrices dependent on two consecutive virtual-bond dihedrals.
2499 C The order of matrices is from left to right.
2500 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2502 c do i=max0(ivec_start,2),ivec_end
2504 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2505 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2506 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2507 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2508 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2509 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2510 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2511 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2514 #if defined(MPI) && defined(PARMAT)
2516 c if (fg_rank.eq.0) then
2517 write (iout,*) "Arrays UG and UGDER before GATHER"
2519 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2520 & ((ug(l,k,i),l=1,2),k=1,2),
2521 & ((ugder(l,k,i),l=1,2),k=1,2)
2523 write (iout,*) "Arrays UG2 and UG2DER"
2525 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2526 & ((ug2(l,k,i),l=1,2),k=1,2),
2527 & ((ug2der(l,k,i),l=1,2),k=1,2)
2529 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2531 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2532 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2533 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2535 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2537 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2538 & costab(i),sintab(i),costab2(i),sintab2(i)
2540 write (iout,*) "Array MUDER"
2542 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2546 if (nfgtasks.gt.1) then
2548 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2549 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2550 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2552 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2553 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2555 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2556 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2558 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2559 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2561 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2562 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2564 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2565 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2567 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2568 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2570 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2571 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2572 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2573 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2574 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2575 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2576 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2577 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2578 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2579 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2580 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2581 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2582 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2584 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2585 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2587 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2588 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2590 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2591 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2593 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2594 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2596 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2597 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2599 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2600 & ivec_count(fg_rank1),
2601 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2603 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2604 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2606 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2607 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2609 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2610 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2612 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2613 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2615 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2616 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2618 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2619 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2621 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2622 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2624 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2625 & ivec_count(fg_rank1),
2626 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2628 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2629 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2631 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2632 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2634 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2635 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2637 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2638 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2640 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2641 & ivec_count(fg_rank1),
2642 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2644 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2645 & ivec_count(fg_rank1),
2646 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2648 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2649 & ivec_count(fg_rank1),
2650 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2651 & MPI_MAT2,FG_COMM1,IERR)
2652 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2653 & ivec_count(fg_rank1),
2654 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2655 & MPI_MAT2,FG_COMM1,IERR)
2658 c Passes matrix info through the ring
2661 if (irecv.lt.0) irecv=nfgtasks1-1
2664 if (inext.ge.nfgtasks1) inext=0
2666 c write (iout,*) "isend",isend," irecv",irecv
2668 lensend=lentyp(isend)
2669 lenrecv=lentyp(irecv)
2670 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2671 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2672 c & MPI_ROTAT1(lensend),inext,2200+isend,
2673 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2674 c & iprev,2200+irecv,FG_COMM,status,IERR)
2675 c write (iout,*) "Gather ROTAT1"
2677 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2678 c & MPI_ROTAT2(lensend),inext,3300+isend,
2679 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2680 c & iprev,3300+irecv,FG_COMM,status,IERR)
2681 c write (iout,*) "Gather ROTAT2"
2683 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2684 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2685 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2686 & iprev,4400+irecv,FG_COMM,status,IERR)
2687 c write (iout,*) "Gather ROTAT_OLD"
2689 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2690 & MPI_PRECOMP11(lensend),inext,5500+isend,
2691 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2692 & iprev,5500+irecv,FG_COMM,status,IERR)
2693 c write (iout,*) "Gather PRECOMP11"
2695 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2696 & MPI_PRECOMP12(lensend),inext,6600+isend,
2697 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2698 & iprev,6600+irecv,FG_COMM,status,IERR)
2699 c write (iout,*) "Gather PRECOMP12"
2701 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2703 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2704 & MPI_ROTAT2(lensend),inext,7700+isend,
2705 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2706 & iprev,7700+irecv,FG_COMM,status,IERR)
2707 c write (iout,*) "Gather PRECOMP21"
2709 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2710 & MPI_PRECOMP22(lensend),inext,8800+isend,
2711 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2712 & iprev,8800+irecv,FG_COMM,status,IERR)
2713 c write (iout,*) "Gather PRECOMP22"
2715 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2716 & MPI_PRECOMP23(lensend),inext,9900+isend,
2717 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2718 & MPI_PRECOMP23(lenrecv),
2719 & iprev,9900+irecv,FG_COMM,status,IERR)
2720 c write (iout,*) "Gather PRECOMP23"
2725 if (irecv.lt.0) irecv=nfgtasks1-1
2728 time_gather=time_gather+MPI_Wtime()-time00
2731 c if (fg_rank.eq.0) then
2732 write (iout,*) "Arrays UG and UGDER"
2734 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2735 & ((ug(l,k,i),l=1,2),k=1,2),
2736 & ((ugder(l,k,i),l=1,2),k=1,2)
2738 write (iout,*) "Arrays UG2 and UG2DER"
2740 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2741 & ((ug2(l,k,i),l=1,2),k=1,2),
2742 & ((ug2der(l,k,i),l=1,2),k=1,2)
2744 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2746 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2747 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2748 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2750 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2752 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2753 & costab(i),sintab(i),costab2(i),sintab2(i)
2755 write (iout,*) "Array MUDER"
2757 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2763 cd iti = itortyp(itype(i))
2766 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2767 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2772 C--------------------------------------------------------------------------
2773 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2775 C This subroutine calculates the average interaction energy and its gradient
2776 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2777 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2778 C The potential depends both on the distance of peptide-group centers and on
2779 C the orientation of the CA-CA virtual bonds.
2781 implicit real*8 (a-h,o-z)
2785 include 'DIMENSIONS'
2786 include 'COMMON.CONTROL'
2787 include 'COMMON.SETUP'
2788 include 'COMMON.IOUNITS'
2789 include 'COMMON.GEO'
2790 include 'COMMON.VAR'
2791 include 'COMMON.LOCAL'
2792 include 'COMMON.CHAIN'
2793 include 'COMMON.DERIV'
2794 include 'COMMON.INTERACT'
2795 include 'COMMON.CONTACTS'
2796 include 'COMMON.TORSION'
2797 include 'COMMON.VECTORS'
2798 include 'COMMON.FFIELD'
2799 include 'COMMON.TIME1'
2800 include 'COMMON.SPLITELE'
2801 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2802 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2803 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2804 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2805 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2806 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2808 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2810 double precision scal_el /1.0d0/
2812 double precision scal_el /0.5d0/
2815 C 13-go grudnia roku pamietnego...
2816 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2817 & 0.0d0,1.0d0,0.0d0,
2818 & 0.0d0,0.0d0,1.0d0/
2819 cd write(iout,*) 'In EELEC'
2821 cd write(iout,*) 'Type',i
2822 cd write(iout,*) 'B1',B1(:,i)
2823 cd write(iout,*) 'B2',B2(:,i)
2824 cd write(iout,*) 'CC',CC(:,:,i)
2825 cd write(iout,*) 'DD',DD(:,:,i)
2826 cd write(iout,*) 'EE',EE(:,:,i)
2828 cd call check_vecgrad
2830 if (icheckgrad.eq.1) then
2832 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2834 dc_norm(k,i)=dc(k,i)*fac
2836 c write (iout,*) 'i',i,' fac',fac
2839 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2840 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2841 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2842 c call vec_and_deriv
2848 time_mat=time_mat+MPI_Wtime()-time01
2852 cd write (iout,*) 'i=',i
2854 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2857 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2858 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2871 cd print '(a)','Enter EELEC'
2872 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2874 gel_loc_loc(i)=0.0d0
2879 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2881 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2883 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
2884 do i=iturn3_start,iturn3_end
2885 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2886 & .or. itype(i+2).eq.ntyp1
2887 & .or. itype(i+3).eq.ntyp1
2888 & .or. itype(i-1).eq.ntyp1
2889 & .or. itype(i+4).eq.ntyp1
2894 dx_normi=dc_norm(1,i)
2895 dy_normi=dc_norm(2,i)
2896 dz_normi=dc_norm(3,i)
2897 xmedi=c(1,i)+0.5d0*dxi
2898 ymedi=c(2,i)+0.5d0*dyi
2899 zmedi=c(3,i)+0.5d0*dzi
2900 C Return atom into box, boxxsize is size of box in x dimension
2902 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2903 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2904 C Condition for being inside the proper box
2905 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
2906 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
2910 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
2911 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2912 cC Condition for being inside the proper box
2913 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
2914 c & (ymedi.lt.((-0.5d0)*boxysize))) then
2918 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2919 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2920 cC Condition for being inside the proper box
2921 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
2922 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
2925 xmedi=mod(xmedi,boxxsize)
2926 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2927 ymedi=mod(ymedi,boxysize)
2928 if (ymedi.lt.0) ymedi=ymedi+boxysize
2929 zmedi=mod(zmedi,boxzsize)
2930 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2932 call eelecij(i,i+2,ees,evdw1,eel_loc)
2933 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2934 num_cont_hb(i)=num_conti
2936 do i=iturn4_start,iturn4_end
2937 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2938 & .or. itype(i+3).eq.ntyp1
2939 & .or. itype(i+4).eq.ntyp1
2940 & .or. itype(i+5).eq.ntyp1
2941 & .or. itype(i).eq.ntyp1
2942 & .or. itype(i-1).eq.ntyp1
2947 dx_normi=dc_norm(1,i)
2948 dy_normi=dc_norm(2,i)
2949 dz_normi=dc_norm(3,i)
2950 xmedi=c(1,i)+0.5d0*dxi
2951 ymedi=c(2,i)+0.5d0*dyi
2952 zmedi=c(3,i)+0.5d0*dzi
2953 C Return atom into box, boxxsize is size of box in x dimension
2955 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2956 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2957 C Condition for being inside the proper box
2958 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
2959 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
2963 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
2964 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2965 C Condition for being inside the proper box
2966 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
2967 c & (ymedi.lt.((-0.5d0)*boxysize))) then
2971 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2972 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2973 C Condition for being inside the proper box
2974 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
2975 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
2978 xmedi=mod(xmedi,boxxsize)
2979 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2980 ymedi=mod(ymedi,boxysize)
2981 if (ymedi.lt.0) ymedi=ymedi+boxysize
2982 zmedi=mod(zmedi,boxzsize)
2983 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2985 num_conti=num_cont_hb(i)
2986 call eelecij(i,i+3,ees,evdw1,eel_loc)
2987 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2988 & call eturn4(i,eello_turn4)
2989 num_cont_hb(i)=num_conti
2991 C Loop over all neighbouring boxes
2996 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2998 do i=iatel_s,iatel_e
2999 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3000 & .or. itype(i+2).eq.ntyp1
3001 & .or. itype(i-1).eq.ntyp1
3006 dx_normi=dc_norm(1,i)
3007 dy_normi=dc_norm(2,i)
3008 dz_normi=dc_norm(3,i)
3009 xmedi=c(1,i)+0.5d0*dxi
3010 ymedi=c(2,i)+0.5d0*dyi
3011 zmedi=c(3,i)+0.5d0*dzi
3012 xmedi=mod(xmedi,boxxsize)
3013 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3014 ymedi=mod(ymedi,boxysize)
3015 if (ymedi.lt.0) ymedi=ymedi+boxysize
3016 zmedi=mod(zmedi,boxzsize)
3017 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3018 xmedi=xmedi+xshift*boxxsize
3019 ymedi=ymedi+yshift*boxysize
3020 zmedi=zmedi+zshift*boxzsize
3022 C Return tom into box, boxxsize is size of box in x dimension
3024 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3025 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3026 C Condition for being inside the proper box
3027 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3028 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3032 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3033 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3034 C Condition for being inside the proper box
3035 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3036 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3040 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3041 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3042 cC Condition for being inside the proper box
3043 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3044 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3048 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3049 num_conti=num_cont_hb(i)
3050 do j=ielstart(i),ielend(i)
3051 c write (iout,*) i,j,itype(i),itype(j)
3052 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3053 & .or.itype(j+2).eq.ntyp1
3054 & .or.itype(j-1).eq.ntyp1
3056 call eelecij(i,j,ees,evdw1,eel_loc)
3058 num_cont_hb(i)=num_conti
3064 c write (iout,*) "Number of loop steps in EELEC:",ind
3066 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3067 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3069 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3070 ccc eel_loc=eel_loc+eello_turn3
3071 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3074 C-------------------------------------------------------------------------------
3075 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3076 implicit real*8 (a-h,o-z)
3077 include 'DIMENSIONS'
3081 include 'COMMON.CONTROL'
3082 include 'COMMON.IOUNITS'
3083 include 'COMMON.GEO'
3084 include 'COMMON.VAR'
3085 include 'COMMON.LOCAL'
3086 include 'COMMON.CHAIN'
3087 include 'COMMON.DERIV'
3088 include 'COMMON.INTERACT'
3089 include 'COMMON.CONTACTS'
3090 include 'COMMON.TORSION'
3091 include 'COMMON.VECTORS'
3092 include 'COMMON.FFIELD'
3093 include 'COMMON.TIME1'
3094 include 'COMMON.SPLITELE'
3095 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3096 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3097 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3098 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3099 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3100 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3102 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3104 double precision scal_el /1.0d0/
3106 double precision scal_el /0.5d0/
3109 C 13-go grudnia roku pamietnego...
3110 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3111 & 0.0d0,1.0d0,0.0d0,
3112 & 0.0d0,0.0d0,1.0d0/
3113 c time00=MPI_Wtime()
3114 cd write (iout,*) "eelecij",i,j
3118 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3119 aaa=app(iteli,itelj)
3120 bbb=bpp(iteli,itelj)
3121 ael6i=ael6(iteli,itelj)
3122 ael3i=ael3(iteli,itelj)
3126 dx_normj=dc_norm(1,j)
3127 dy_normj=dc_norm(2,j)
3128 dz_normj=dc_norm(3,j)
3129 C xj=c(1,j)+0.5D0*dxj-xmedi
3130 C yj=c(2,j)+0.5D0*dyj-ymedi
3131 C zj=c(3,j)+0.5D0*dzj-zmedi
3136 if (xj.lt.0) xj=xj+boxxsize
3138 if (yj.lt.0) yj=yj+boxysize
3140 if (zj.lt.0) zj=zj+boxzsize
3142 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3144 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3145 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3146 C Condition for being inside the proper box
3147 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3148 c & (xj.lt.((-0.5d0)*boxxsize))) then
3152 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3153 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3154 C Condition for being inside the proper box
3155 c if ((yj.gt.((0.5d0)*boxysize)).or.
3156 c & (yj.lt.((-0.5d0)*boxysize))) then
3160 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3161 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3162 C Condition for being inside the proper box
3163 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3164 c & (zj.lt.((-0.5d0)*boxzsize))) then
3167 C endif !endPBC condintion
3171 rij=xj*xj+yj*yj+zj*zj
3173 sss=sscale(sqrt(rij))
3174 sssgrad=sscagrad(sqrt(rij))
3175 c if (sss.gt.0.0d0) then
3181 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3182 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3183 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3184 fac=cosa-3.0D0*cosb*cosg
3186 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3187 if (j.eq.i+2) ev1=scal_el*ev1
3192 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3196 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3197 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3199 evdw1=evdw1+evdwij*sss
3200 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3201 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3202 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3203 cd & xmedi,ymedi,zmedi,xj,yj,zj
3205 if (energy_dec) then
3206 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3208 &,iteli,itelj,aaa,evdw1
3209 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3213 C Calculate contributions to the Cartesian gradient.
3216 facvdw=-6*rrmij*(ev1+evdwij)*sss
3217 facel=-3*rrmij*(el1+eesij)
3223 * Radial derivatives. First process both termini of the fragment (i,j)
3229 c ghalf=0.5D0*ggg(k)
3230 c gelc(k,i)=gelc(k,i)+ghalf
3231 c gelc(k,j)=gelc(k,j)+ghalf
3233 c 9/28/08 AL Gradient compotents will be summed only at the end
3235 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3236 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3239 * Loop over residues i+1 thru j-1.
3243 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3246 if (sss.gt.0.0) then
3247 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3248 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3249 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3256 c ghalf=0.5D0*ggg(k)
3257 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3258 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3260 c 9/28/08 AL Gradient compotents will be summed only at the end
3262 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3263 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3266 * Loop over residues i+1 thru j-1.
3270 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3275 facvdw=(ev1+evdwij)*sss
3278 fac=-3*rrmij*(facvdw+facvdw+facel)
3283 * Radial derivatives. First process both termini of the fragment (i,j)
3289 c ghalf=0.5D0*ggg(k)
3290 c gelc(k,i)=gelc(k,i)+ghalf
3291 c gelc(k,j)=gelc(k,j)+ghalf
3293 c 9/28/08 AL Gradient compotents will be summed only at the end
3295 gelc_long(k,j)=gelc(k,j)+ggg(k)
3296 gelc_long(k,i)=gelc(k,i)-ggg(k)
3299 * Loop over residues i+1 thru j-1.
3303 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3306 c 9/28/08 AL Gradient compotents will be summed only at the end
3307 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3308 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3309 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3311 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3312 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3318 ecosa=2.0D0*fac3*fac1+fac4
3321 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3322 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3324 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3325 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3327 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3328 cd & (dcosg(k),k=1,3)
3330 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3333 c ghalf=0.5D0*ggg(k)
3334 c gelc(k,i)=gelc(k,i)+ghalf
3335 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3336 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3337 c gelc(k,j)=gelc(k,j)+ghalf
3338 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3339 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3343 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3348 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3349 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3351 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3352 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3353 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3354 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3358 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3359 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3360 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3362 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3363 C energy of a peptide unit is assumed in the form of a second-order
3364 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3365 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3366 C are computed for EVERY pair of non-contiguous peptide groups.
3368 if (j.lt.nres-1) then
3379 muij(kkk)=mu(k,i)*mu(l,j)
3382 cd write (iout,*) 'EELEC: i',i,' j',j
3383 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3384 cd write(iout,*) 'muij',muij
3385 ury=scalar(uy(1,i),erij)
3386 urz=scalar(uz(1,i),erij)
3387 vry=scalar(uy(1,j),erij)
3388 vrz=scalar(uz(1,j),erij)
3389 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3390 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3391 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3392 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3393 fac=dsqrt(-ael6i)*r3ij
3398 cd write (iout,'(4i5,4f10.5)')
3399 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3400 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3401 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3402 cd & uy(:,j),uz(:,j)
3403 cd write (iout,'(4f10.5)')
3404 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3405 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3406 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3407 cd write (iout,'(9f10.5/)')
3408 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3409 C Derivatives of the elements of A in virtual-bond vectors
3410 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3412 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3413 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3414 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3415 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3416 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3417 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3418 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3419 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3420 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3421 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3422 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3423 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3425 C Compute radial contributions to the gradient
3443 C Add the contributions coming from er
3446 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3447 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3448 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3449 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3452 C Derivatives in DC(i)
3453 cgrad ghalf1=0.5d0*agg(k,1)
3454 cgrad ghalf2=0.5d0*agg(k,2)
3455 cgrad ghalf3=0.5d0*agg(k,3)
3456 cgrad ghalf4=0.5d0*agg(k,4)
3457 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3458 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3459 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3460 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3461 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3462 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3463 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3464 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3465 C Derivatives in DC(i+1)
3466 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3467 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3468 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3469 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3470 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3471 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3472 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3473 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3474 C Derivatives in DC(j)
3475 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3476 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3477 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3478 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3479 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3480 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3481 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3482 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3483 C Derivatives in DC(j+1) or DC(nres-1)
3484 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3485 & -3.0d0*vryg(k,3)*ury)
3486 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3487 & -3.0d0*vrzg(k,3)*ury)
3488 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3489 & -3.0d0*vryg(k,3)*urz)
3490 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3491 & -3.0d0*vrzg(k,3)*urz)
3492 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3494 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3507 aggi(k,l)=-aggi(k,l)
3508 aggi1(k,l)=-aggi1(k,l)
3509 aggj(k,l)=-aggj(k,l)
3510 aggj1(k,l)=-aggj1(k,l)
3513 if (j.lt.nres-1) then
3519 aggi(k,l)=-aggi(k,l)
3520 aggi1(k,l)=-aggi1(k,l)
3521 aggj(k,l)=-aggj(k,l)
3522 aggj1(k,l)=-aggj1(k,l)
3533 aggi(k,l)=-aggi(k,l)
3534 aggi1(k,l)=-aggi1(k,l)
3535 aggj(k,l)=-aggj(k,l)
3536 aggj1(k,l)=-aggj1(k,l)
3541 IF (wel_loc.gt.0.0d0) THEN
3542 C Contribution to the local-electrostatic energy coming from the i-j pair
3543 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3545 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3546 c & ' eel_loc_ij',eel_loc_ij
3548 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3549 & 'eelloc',i,j,eel_loc_ij
3550 c if (eel_loc_ij.ne.0)
3551 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3552 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3554 eel_loc=eel_loc+eel_loc_ij
3555 C Partial derivatives in virtual-bond dihedral angles gamma
3557 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3558 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3559 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3560 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3561 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3562 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3563 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3565 ggg(l)=agg(l,1)*muij(1)+
3566 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3567 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3568 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3569 cgrad ghalf=0.5d0*ggg(l)
3570 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3571 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3575 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3578 C Remaining derivatives of eello
3580 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3581 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3582 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3583 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3584 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3585 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3586 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3587 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3590 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3591 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3592 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3593 & .and. num_conti.le.maxconts) then
3594 c write (iout,*) i,j," entered corr"
3596 C Calculate the contact function. The ith column of the array JCONT will
3597 C contain the numbers of atoms that make contacts with the atom I (of numbers
3598 C greater than I). The arrays FACONT and GACONT will contain the values of
3599 C the contact function and its derivative.
3600 c r0ij=1.02D0*rpp(iteli,itelj)
3601 c r0ij=1.11D0*rpp(iteli,itelj)
3602 r0ij=2.20D0*rpp(iteli,itelj)
3603 c r0ij=1.55D0*rpp(iteli,itelj)
3604 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3605 if (fcont.gt.0.0D0) then
3606 num_conti=num_conti+1
3607 if (num_conti.gt.maxconts) then
3608 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3609 & ' will skip next contacts for this conf.'
3611 jcont_hb(num_conti,i)=j
3612 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3613 cd & " jcont_hb",jcont_hb(num_conti,i)
3614 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3615 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3616 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3618 d_cont(num_conti,i)=rij
3619 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3620 C --- Electrostatic-interaction matrix ---
3621 a_chuj(1,1,num_conti,i)=a22
3622 a_chuj(1,2,num_conti,i)=a23
3623 a_chuj(2,1,num_conti,i)=a32
3624 a_chuj(2,2,num_conti,i)=a33
3625 C --- Gradient of rij
3627 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3634 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3635 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3636 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3637 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3638 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3643 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3644 C Calculate contact energies
3646 wij=cosa-3.0D0*cosb*cosg
3649 c fac3=dsqrt(-ael6i)/r0ij**3
3650 fac3=dsqrt(-ael6i)*r3ij
3651 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3652 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3653 if (ees0tmp.gt.0) then
3654 ees0pij=dsqrt(ees0tmp)
3658 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3659 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3660 if (ees0tmp.gt.0) then
3661 ees0mij=dsqrt(ees0tmp)
3666 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3667 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3668 C Diagnostics. Comment out or remove after debugging!
3669 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3670 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3671 c ees0m(num_conti,i)=0.0D0
3673 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3674 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3675 C Angular derivatives of the contact function
3676 ees0pij1=fac3/ees0pij
3677 ees0mij1=fac3/ees0mij
3678 fac3p=-3.0D0*fac3*rrmij
3679 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3680 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3682 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3683 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3684 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3685 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3686 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3687 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3688 ecosap=ecosa1+ecosa2
3689 ecosbp=ecosb1+ecosb2
3690 ecosgp=ecosg1+ecosg2
3691 ecosam=ecosa1-ecosa2
3692 ecosbm=ecosb1-ecosb2
3693 ecosgm=ecosg1-ecosg2
3702 facont_hb(num_conti,i)=fcont
3703 fprimcont=fprimcont/rij
3704 cd facont_hb(num_conti,i)=1.0D0
3705 C Following line is for diagnostics.
3708 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3709 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3712 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3713 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3715 gggp(1)=gggp(1)+ees0pijp*xj
3716 gggp(2)=gggp(2)+ees0pijp*yj
3717 gggp(3)=gggp(3)+ees0pijp*zj
3718 gggm(1)=gggm(1)+ees0mijp*xj
3719 gggm(2)=gggm(2)+ees0mijp*yj
3720 gggm(3)=gggm(3)+ees0mijp*zj
3721 C Derivatives due to the contact function
3722 gacont_hbr(1,num_conti,i)=fprimcont*xj
3723 gacont_hbr(2,num_conti,i)=fprimcont*yj
3724 gacont_hbr(3,num_conti,i)=fprimcont*zj
3727 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3728 c following the change of gradient-summation algorithm.
3730 cgrad ghalfp=0.5D0*gggp(k)
3731 cgrad ghalfm=0.5D0*gggm(k)
3732 gacontp_hb1(k,num_conti,i)=!ghalfp
3733 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3734 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3735 gacontp_hb2(k,num_conti,i)=!ghalfp
3736 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3737 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3738 gacontp_hb3(k,num_conti,i)=gggp(k)
3739 gacontm_hb1(k,num_conti,i)=!ghalfm
3740 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3741 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3742 gacontm_hb2(k,num_conti,i)=!ghalfm
3743 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3744 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3745 gacontm_hb3(k,num_conti,i)=gggm(k)
3747 C Diagnostics. Comment out or remove after debugging!
3749 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3750 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3751 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3752 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3753 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3754 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3757 endif ! num_conti.le.maxconts
3760 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3763 ghalf=0.5d0*agg(l,k)
3764 aggi(l,k)=aggi(l,k)+ghalf
3765 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3766 aggj(l,k)=aggj(l,k)+ghalf
3769 if (j.eq.nres-1 .and. i.lt.j-2) then
3772 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3777 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3780 C-----------------------------------------------------------------------------
3781 subroutine eturn3(i,eello_turn3)
3782 C Third- and fourth-order contributions from turns
3783 implicit real*8 (a-h,o-z)
3784 include 'DIMENSIONS'
3785 include 'COMMON.IOUNITS'
3786 include 'COMMON.GEO'
3787 include 'COMMON.VAR'
3788 include 'COMMON.LOCAL'
3789 include 'COMMON.CHAIN'
3790 include 'COMMON.DERIV'
3791 include 'COMMON.INTERACT'
3792 include 'COMMON.CONTACTS'
3793 include 'COMMON.TORSION'
3794 include 'COMMON.VECTORS'
3795 include 'COMMON.FFIELD'
3796 include 'COMMON.CONTROL'
3798 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3799 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3800 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3801 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3802 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3803 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3804 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3807 c write (iout,*) "eturn3",i,j,j1,j2
3812 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3814 C Third-order contributions
3821 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3822 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3823 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3824 call transpose2(auxmat(1,1),auxmat1(1,1))
3825 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3826 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3827 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3828 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3829 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3830 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3831 cd & ' eello_turn3_num',4*eello_turn3_num
3832 C Derivatives in gamma(i)
3833 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3834 call transpose2(auxmat2(1,1),auxmat3(1,1))
3835 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3836 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3837 C Derivatives in gamma(i+1)
3838 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3839 call transpose2(auxmat2(1,1),auxmat3(1,1))
3840 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3841 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3842 & +0.5d0*(pizda(1,1)+pizda(2,2))
3843 C Cartesian derivatives
3845 c ghalf1=0.5d0*agg(l,1)
3846 c ghalf2=0.5d0*agg(l,2)
3847 c ghalf3=0.5d0*agg(l,3)
3848 c ghalf4=0.5d0*agg(l,4)
3849 a_temp(1,1)=aggi(l,1)!+ghalf1
3850 a_temp(1,2)=aggi(l,2)!+ghalf2
3851 a_temp(2,1)=aggi(l,3)!+ghalf3
3852 a_temp(2,2)=aggi(l,4)!+ghalf4
3853 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3854 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3855 & +0.5d0*(pizda(1,1)+pizda(2,2))
3856 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3857 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3858 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3859 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3860 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3861 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3862 & +0.5d0*(pizda(1,1)+pizda(2,2))
3863 a_temp(1,1)=aggj(l,1)!+ghalf1
3864 a_temp(1,2)=aggj(l,2)!+ghalf2
3865 a_temp(2,1)=aggj(l,3)!+ghalf3
3866 a_temp(2,2)=aggj(l,4)!+ghalf4
3867 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3868 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3869 & +0.5d0*(pizda(1,1)+pizda(2,2))
3870 a_temp(1,1)=aggj1(l,1)
3871 a_temp(1,2)=aggj1(l,2)
3872 a_temp(2,1)=aggj1(l,3)
3873 a_temp(2,2)=aggj1(l,4)
3874 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3875 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3876 & +0.5d0*(pizda(1,1)+pizda(2,2))
3880 C-------------------------------------------------------------------------------
3881 subroutine eturn4(i,eello_turn4)
3882 C Third- and fourth-order contributions from turns
3883 implicit real*8 (a-h,o-z)
3884 include 'DIMENSIONS'
3885 include 'COMMON.IOUNITS'
3886 include 'COMMON.GEO'
3887 include 'COMMON.VAR'
3888 include 'COMMON.LOCAL'
3889 include 'COMMON.CHAIN'
3890 include 'COMMON.DERIV'
3891 include 'COMMON.INTERACT'
3892 include 'COMMON.CONTACTS'
3893 include 'COMMON.TORSION'
3894 include 'COMMON.VECTORS'
3895 include 'COMMON.FFIELD'
3896 include 'COMMON.CONTROL'
3898 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3899 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3900 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3901 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3902 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3903 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3904 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3907 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3909 C Fourth-order contributions
3917 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3918 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3919 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3924 iti1=itortyp(itype(i+1))
3925 iti2=itortyp(itype(i+2))
3926 iti3=itortyp(itype(i+3))
3927 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3928 call transpose2(EUg(1,1,i+1),e1t(1,1))
3929 call transpose2(Eug(1,1,i+2),e2t(1,1))
3930 call transpose2(Eug(1,1,i+3),e3t(1,1))
3931 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3932 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3933 s1=scalar2(b1(1,iti2),auxvec(1))
3934 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3935 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3936 s2=scalar2(b1(1,iti1),auxvec(1))
3937 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3938 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3939 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3940 eello_turn4=eello_turn4-(s1+s2+s3)
3941 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
3942 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
3943 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
3944 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3945 cd & ' eello_turn4_num',8*eello_turn4_num
3946 C Derivatives in gamma(i)
3947 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3948 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3949 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3950 s1=scalar2(b1(1,iti2),auxvec(1))
3951 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3952 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3953 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3954 C Derivatives in gamma(i+1)
3955 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3956 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3957 s2=scalar2(b1(1,iti1),auxvec(1))
3958 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3959 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3960 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3961 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3962 C Derivatives in gamma(i+2)
3963 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3964 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3965 s1=scalar2(b1(1,iti2),auxvec(1))
3966 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3967 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3968 s2=scalar2(b1(1,iti1),auxvec(1))
3969 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3970 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3971 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3972 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3973 C Cartesian derivatives
3974 C Derivatives of this turn contributions in DC(i+2)
3975 if (j.lt.nres-1) then
3977 a_temp(1,1)=agg(l,1)
3978 a_temp(1,2)=agg(l,2)
3979 a_temp(2,1)=agg(l,3)
3980 a_temp(2,2)=agg(l,4)
3981 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3982 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3983 s1=scalar2(b1(1,iti2),auxvec(1))
3984 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3985 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3986 s2=scalar2(b1(1,iti1),auxvec(1))
3987 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3988 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3989 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3991 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3994 C Remaining derivatives of this turn contribution
3996 a_temp(1,1)=aggi(l,1)
3997 a_temp(1,2)=aggi(l,2)
3998 a_temp(2,1)=aggi(l,3)
3999 a_temp(2,2)=aggi(l,4)
4000 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4001 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4002 s1=scalar2(b1(1,iti2),auxvec(1))
4003 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4004 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4005 s2=scalar2(b1(1,iti1),auxvec(1))
4006 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4007 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4008 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4009 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4010 a_temp(1,1)=aggi1(l,1)
4011 a_temp(1,2)=aggi1(l,2)
4012 a_temp(2,1)=aggi1(l,3)
4013 a_temp(2,2)=aggi1(l,4)
4014 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4015 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4016 s1=scalar2(b1(1,iti2),auxvec(1))
4017 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4018 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4019 s2=scalar2(b1(1,iti1),auxvec(1))
4020 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4021 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4022 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4023 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4024 a_temp(1,1)=aggj(l,1)
4025 a_temp(1,2)=aggj(l,2)
4026 a_temp(2,1)=aggj(l,3)
4027 a_temp(2,2)=aggj(l,4)
4028 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4029 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4030 s1=scalar2(b1(1,iti2),auxvec(1))
4031 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4032 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4033 s2=scalar2(b1(1,iti1),auxvec(1))
4034 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4035 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4036 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4037 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4038 a_temp(1,1)=aggj1(l,1)
4039 a_temp(1,2)=aggj1(l,2)
4040 a_temp(2,1)=aggj1(l,3)
4041 a_temp(2,2)=aggj1(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))
4051 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4052 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4056 C-----------------------------------------------------------------------------
4057 subroutine vecpr(u,v,w)
4058 implicit real*8(a-h,o-z)
4059 dimension u(3),v(3),w(3)
4060 w(1)=u(2)*v(3)-u(3)*v(2)
4061 w(2)=-u(1)*v(3)+u(3)*v(1)
4062 w(3)=u(1)*v(2)-u(2)*v(1)
4065 C-----------------------------------------------------------------------------
4066 subroutine unormderiv(u,ugrad,unorm,ungrad)
4067 C This subroutine computes the derivatives of a normalized vector u, given
4068 C the derivatives computed without normalization conditions, ugrad. Returns
4071 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4072 double precision vec(3)
4073 double precision scalar
4075 c write (2,*) 'ugrad',ugrad
4078 vec(i)=scalar(ugrad(1,i),u(1))
4080 c write (2,*) 'vec',vec
4083 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4086 c write (2,*) 'ungrad',ungrad
4089 C-----------------------------------------------------------------------------
4090 subroutine escp_soft_sphere(evdw2,evdw2_14)
4092 C This subroutine calculates the excluded-volume interaction energy between
4093 C peptide-group centers and side chains and its gradient in virtual-bond and
4094 C side-chain vectors.
4096 implicit real*8 (a-h,o-z)
4097 include 'DIMENSIONS'
4098 include 'COMMON.GEO'
4099 include 'COMMON.VAR'
4100 include 'COMMON.LOCAL'
4101 include 'COMMON.CHAIN'
4102 include 'COMMON.DERIV'
4103 include 'COMMON.INTERACT'
4104 include 'COMMON.FFIELD'
4105 include 'COMMON.IOUNITS'
4106 include 'COMMON.CONTROL'
4111 cd print '(a)','Enter ESCP'
4112 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4116 do i=iatscp_s,iatscp_e
4117 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4119 xi=0.5D0*(c(1,i)+c(1,i+1))
4120 yi=0.5D0*(c(2,i)+c(2,i+1))
4121 zi=0.5D0*(c(3,i)+c(3,i+1))
4122 C Return atom into box, boxxsize is size of box in x dimension
4124 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4125 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4126 C Condition for being inside the proper box
4127 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4128 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4132 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4133 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4134 C Condition for being inside the proper box
4135 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4136 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4140 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4141 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4142 cC Condition for being inside the proper box
4143 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4144 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4148 if (xi.lt.0) xi=xi+boxxsize
4150 if (yi.lt.0) yi=yi+boxysize
4152 if (zi.lt.0) zi=zi+boxzsize
4153 xi=xi+xshift*boxxsize
4154 yi=yi+yshift*boxysize
4155 zi=zi+zshift*boxzsize
4156 do iint=1,nscp_gr(i)
4158 do j=iscpstart(i,iint),iscpend(i,iint)
4159 if (itype(j).eq.ntyp1) cycle
4160 itypj=iabs(itype(j))
4161 C Uncomment following three lines for SC-p interactions
4165 C Uncomment following three lines for Ca-p interactions
4170 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4171 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4172 C Condition for being inside the proper box
4173 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4174 c & (xj.lt.((-0.5d0)*boxxsize))) then
4178 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4179 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4180 cC Condition for being inside the proper box
4181 c if ((yj.gt.((0.5d0)*boxysize)).or.
4182 c & (yj.lt.((-0.5d0)*boxysize))) then
4186 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4187 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4188 C Condition for being inside the proper box
4189 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4190 c & (zj.lt.((-0.5d0)*boxzsize))) then
4193 if (xj.lt.0) xj=xj+boxxsize
4195 if (yj.lt.0) yj=yj+boxysize
4197 if (zj.lt.0) zj=zj+boxzsize
4202 rij=xj*xj+yj*yj+zj*zj
4206 if (rij.lt.r0ijsq) then
4207 evdwij=0.25d0*(rij-r0ijsq)**2
4215 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4220 cgrad if (j.lt.i) then
4221 cd write (iout,*) 'j<i'
4222 C Uncomment following three lines for SC-p interactions
4224 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4227 cd write (iout,*) 'j>i'
4229 cgrad ggg(k)=-ggg(k)
4230 C Uncomment following line for SC-p interactions
4231 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4235 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4237 cgrad kstart=min0(i+1,j)
4238 cgrad kend=max0(i-1,j-1)
4239 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4240 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4241 cgrad do k=kstart,kend
4243 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4247 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4248 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4259 C-----------------------------------------------------------------------------
4260 subroutine escp(evdw2,evdw2_14)
4262 C This subroutine calculates the excluded-volume interaction energy between
4263 C peptide-group centers and side chains and its gradient in virtual-bond and
4264 C side-chain vectors.
4266 implicit real*8 (a-h,o-z)
4267 include 'DIMENSIONS'
4268 include 'COMMON.GEO'
4269 include 'COMMON.VAR'
4270 include 'COMMON.LOCAL'
4271 include 'COMMON.CHAIN'
4272 include 'COMMON.DERIV'
4273 include 'COMMON.INTERACT'
4274 include 'COMMON.FFIELD'
4275 include 'COMMON.IOUNITS'
4276 include 'COMMON.CONTROL'
4277 include 'COMMON.SPLITELE'
4281 cd print '(a)','Enter ESCP'
4282 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4286 do i=iatscp_s,iatscp_e
4287 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4289 xi=0.5D0*(c(1,i)+c(1,i+1))
4290 yi=0.5D0*(c(2,i)+c(2,i+1))
4291 zi=0.5D0*(c(3,i)+c(3,i+1))
4293 if (xi.lt.0) xi=xi+boxxsize
4295 if (yi.lt.0) yi=yi+boxysize
4297 if (zi.lt.0) zi=zi+boxzsize
4298 xi=xi+xshift*boxxsize
4299 yi=yi+yshift*boxysize
4300 zi=zi+zshift*boxzsize
4301 C Return atom into box, boxxsize is size of box in x dimension
4303 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4304 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4305 C Condition for being inside the proper box
4306 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4307 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4311 c print *,xi,boxxsize,"pierwszy"
4313 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4314 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4315 C Condition for being inside the proper box
4316 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4317 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4321 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4322 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4323 C Condition for being inside the proper box
4324 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4325 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4328 do iint=1,nscp_gr(i)
4330 do j=iscpstart(i,iint),iscpend(i,iint)
4331 itypj=iabs(itype(j))
4332 if (itypj.eq.ntyp1) cycle
4333 C Uncomment following three lines for SC-p interactions
4337 C Uncomment following three lines for Ca-p interactions
4342 if (xj.lt.0) xj=xj+boxxsize
4344 if (yj.lt.0) yj=yj+boxysize
4346 if (zj.lt.0) zj=zj+boxzsize
4348 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4349 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4350 C Condition for being inside the proper box
4351 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4352 c & (xj.lt.((-0.5d0)*boxxsize))) then
4356 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4357 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4358 cC Condition for being inside the proper box
4359 c if ((yj.gt.((0.5d0)*boxysize)).or.
4360 c & (yj.lt.((-0.5d0)*boxysize))) then
4364 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4365 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4366 C Condition for being inside the proper box
4367 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4368 c & (zj.lt.((-0.5d0)*boxzsize))) then
4374 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4375 sss=sscale(1.0d0/(dsqrt(rrij)))
4376 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4377 if (sss.gt.0.0d0) then
4379 e1=fac*fac*aad(itypj,iteli)
4380 e2=fac*bad(itypj,iteli)
4381 if (iabs(j-i) .le. 2) then
4384 evdw2_14=evdw2_14+(e1+e2)*sss
4387 evdw2=evdw2+evdwij*sss
4388 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4389 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4392 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4394 fac=-(evdwij+e1)*rrij*sss
4395 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4399 cgrad if (j.lt.i) then
4400 cd write (iout,*) 'j<i'
4401 C Uncomment following three lines for SC-p interactions
4403 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4406 cd write (iout,*) 'j>i'
4408 cgrad ggg(k)=-ggg(k)
4409 C Uncomment following line for SC-p interactions
4410 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4411 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4415 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4417 cgrad kstart=min0(i+1,j)
4418 cgrad kend=max0(i-1,j-1)
4419 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4420 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4421 cgrad do k=kstart,kend
4423 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4427 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4428 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4430 endif !endif for sscale cutoff
4440 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4441 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4442 gradx_scp(j,i)=expon*gradx_scp(j,i)
4445 C******************************************************************************
4449 C To save time the factor EXPON has been extracted from ALL components
4450 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4453 C******************************************************************************
4456 C--------------------------------------------------------------------------
4457 subroutine edis(ehpb)
4459 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4461 implicit real*8 (a-h,o-z)
4462 include 'DIMENSIONS'
4463 include 'COMMON.SBRIDGE'
4464 include 'COMMON.CHAIN'
4465 include 'COMMON.DERIV'
4466 include 'COMMON.VAR'
4467 include 'COMMON.INTERACT'
4468 include 'COMMON.IOUNITS'
4471 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4472 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4473 if (link_end.eq.0) return
4474 do i=link_start,link_end
4475 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4476 C CA-CA distance used in regularization of structure.
4479 C iii and jjj point to the residues for which the distance is assigned.
4480 if (ii.gt.nres) then
4487 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4488 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4489 C distance and angle dependent SS bond potential.
4490 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4491 & iabs(itype(jjj)).eq.1) then
4492 call ssbond_ene(iii,jjj,eij)
4494 cd write (iout,*) "eij",eij
4496 C Calculate the distance between the two points and its difference from the
4500 C Get the force constant corresponding to this distance.
4502 C Calculate the contribution to energy.
4503 ehpb=ehpb+waga*rdis*rdis
4505 C Evaluate gradient.
4508 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4509 cd & ' waga=',waga,' fac=',fac
4511 ggg(j)=fac*(c(j,jj)-c(j,ii))
4513 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4514 C If this is a SC-SC distance, we need to calculate the contributions to the
4515 C Cartesian gradient in the SC vectors (ghpbx).
4518 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4519 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4522 cgrad do j=iii,jjj-1
4524 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4528 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4529 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4536 C--------------------------------------------------------------------------
4537 subroutine ssbond_ene(i,j,eij)
4539 C Calculate the distance and angle dependent SS-bond potential energy
4540 C using a free-energy function derived based on RHF/6-31G** ab initio
4541 C calculations of diethyl disulfide.
4543 C A. Liwo and U. Kozlowska, 11/24/03
4545 implicit real*8 (a-h,o-z)
4546 include 'DIMENSIONS'
4547 include 'COMMON.SBRIDGE'
4548 include 'COMMON.CHAIN'
4549 include 'COMMON.DERIV'
4550 include 'COMMON.LOCAL'
4551 include 'COMMON.INTERACT'
4552 include 'COMMON.VAR'
4553 include 'COMMON.IOUNITS'
4554 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4555 itypi=iabs(itype(i))
4559 dxi=dc_norm(1,nres+i)
4560 dyi=dc_norm(2,nres+i)
4561 dzi=dc_norm(3,nres+i)
4562 c dsci_inv=dsc_inv(itypi)
4563 dsci_inv=vbld_inv(nres+i)
4564 itypj=iabs(itype(j))
4565 c dscj_inv=dsc_inv(itypj)
4566 dscj_inv=vbld_inv(nres+j)
4570 dxj=dc_norm(1,nres+j)
4571 dyj=dc_norm(2,nres+j)
4572 dzj=dc_norm(3,nres+j)
4573 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4578 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4579 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4580 om12=dxi*dxj+dyi*dyj+dzi*dzj
4582 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4583 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4589 deltat12=om2-om1+2.0d0
4591 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4592 & +akct*deltad*deltat12
4593 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4594 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4595 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4596 c & " deltat12",deltat12," eij",eij
4597 ed=2*akcm*deltad+akct*deltat12
4599 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4600 eom1=-2*akth*deltat1-pom1-om2*pom2
4601 eom2= 2*akth*deltat2+pom1-om1*pom2
4604 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4605 ghpbx(k,i)=ghpbx(k,i)-ggk
4606 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4607 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4608 ghpbx(k,j)=ghpbx(k,j)+ggk
4609 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4610 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4611 ghpbc(k,i)=ghpbc(k,i)-ggk
4612 ghpbc(k,j)=ghpbc(k,j)+ggk
4615 C Calculate the components of the gradient in DC and X
4619 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4624 C--------------------------------------------------------------------------
4625 subroutine ebond(estr)
4627 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4629 implicit real*8 (a-h,o-z)
4630 include 'DIMENSIONS'
4631 include 'COMMON.LOCAL'
4632 include 'COMMON.GEO'
4633 include 'COMMON.INTERACT'
4634 include 'COMMON.DERIV'
4635 include 'COMMON.VAR'
4636 include 'COMMON.CHAIN'
4637 include 'COMMON.IOUNITS'
4638 include 'COMMON.NAMES'
4639 include 'COMMON.FFIELD'
4640 include 'COMMON.CONTROL'
4641 include 'COMMON.SETUP'
4642 double precision u(3),ud(3)
4645 do i=ibondp_start,ibondp_end
4646 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4647 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4649 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4650 c & *dc(j,i-1)/vbld(i)
4652 c if (energy_dec) write(iout,*)
4653 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4655 C Checking if it involves dummy (NH3+ or COO-) group
4656 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4657 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
4658 diff = vbld(i)-vbldpDUM
4660 C NO vbldp0 is the equlibrium lenght of spring for peptide group
4661 diff = vbld(i)-vbldp0
4663 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
4664 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4667 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4669 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4672 estr=0.5d0*AKP*estr+estr1
4674 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4676 do i=ibond_start,ibond_end
4678 if (iti.ne.10 .and. iti.ne.ntyp1) then
4681 diff=vbld(i+nres)-vbldsc0(1,iti)
4682 if (energy_dec) write (iout,*)
4683 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4684 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4685 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4687 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4691 diff=vbld(i+nres)-vbldsc0(j,iti)
4692 ud(j)=aksc(j,iti)*diff
4693 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4707 uprod2=uprod2*u(k)*u(k)
4711 usumsqder=usumsqder+ud(j)*uprod2
4713 estr=estr+uprod/usum
4715 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4723 C--------------------------------------------------------------------------
4724 subroutine ebend(etheta)
4726 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4727 C angles gamma and its derivatives in consecutive thetas and gammas.
4729 implicit real*8 (a-h,o-z)
4730 include 'DIMENSIONS'
4731 include 'COMMON.LOCAL'
4732 include 'COMMON.GEO'
4733 include 'COMMON.INTERACT'
4734 include 'COMMON.DERIV'
4735 include 'COMMON.VAR'
4736 include 'COMMON.CHAIN'
4737 include 'COMMON.IOUNITS'
4738 include 'COMMON.NAMES'
4739 include 'COMMON.FFIELD'
4740 include 'COMMON.CONTROL'
4741 common /calcthet/ term1,term2,termm,diffak,ratak,
4742 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4743 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4744 double precision y(2),z(2)
4746 c time11=dexp(-2*time)
4749 c write (*,'(a,i2)') 'EBEND ICG=',icg
4750 do i=ithet_start,ithet_end
4751 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4752 & .or.itype(i).eq.ntyp1) cycle
4753 C Zero the energy function and its derivative at 0 or pi.
4754 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4756 ichir1=isign(1,itype(i-2))
4757 ichir2=isign(1,itype(i))
4758 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4759 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4760 if (itype(i-1).eq.10) then
4761 itype1=isign(10,itype(i-2))
4762 ichir11=isign(1,itype(i-2))
4763 ichir12=isign(1,itype(i-2))
4764 itype2=isign(10,itype(i))
4765 ichir21=isign(1,itype(i))
4766 ichir22=isign(1,itype(i))
4769 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4772 if (phii.ne.phii) phii=150.0
4782 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4785 if (phii1.ne.phii1) phii1=150.0
4797 C Calculate the "mean" value of theta from the part of the distribution
4798 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4799 C In following comments this theta will be referred to as t_c.
4800 thet_pred_mean=0.0d0
4802 athetk=athet(k,it,ichir1,ichir2)
4803 bthetk=bthet(k,it,ichir1,ichir2)
4805 athetk=athet(k,itype1,ichir11,ichir12)
4806 bthetk=bthet(k,itype2,ichir21,ichir22)
4808 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4809 c write(iout,*) 'chuj tu', y(k),z(k)
4811 dthett=thet_pred_mean*ssd
4812 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4813 C Derivatives of the "mean" values in gamma1 and gamma2.
4814 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4815 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4816 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4817 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4819 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4820 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4821 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4822 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4824 if (theta(i).gt.pi-delta) then
4825 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4827 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4828 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4829 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4831 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4833 else if (theta(i).lt.delta) then
4834 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4835 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4836 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4838 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4839 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4842 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4845 etheta=etheta+ethetai
4846 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4847 & 'ebend',i,ethetai,theta(i),itype(i)
4848 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4849 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4850 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
4852 C Ufff.... We've done all this!!!
4855 C---------------------------------------------------------------------------
4856 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4858 implicit real*8 (a-h,o-z)
4859 include 'DIMENSIONS'
4860 include 'COMMON.LOCAL'
4861 include 'COMMON.IOUNITS'
4862 common /calcthet/ term1,term2,termm,diffak,ratak,
4863 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4864 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4865 C Calculate the contributions to both Gaussian lobes.
4866 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4867 C The "polynomial part" of the "standard deviation" of this part of
4868 C the distributioni.
4869 ccc write (iout,*) thetai,thet_pred_mean
4872 sig=sig*thet_pred_mean+polthet(j,it)
4874 C Derivative of the "interior part" of the "standard deviation of the"
4875 C gamma-dependent Gaussian lobe in t_c.
4876 sigtc=3*polthet(3,it)
4878 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4881 C Set the parameters of both Gaussian lobes of the distribution.
4882 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4883 fac=sig*sig+sigc0(it)
4886 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4887 sigsqtc=-4.0D0*sigcsq*sigtc
4888 c print *,i,sig,sigtc,sigsqtc
4889 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4890 sigtc=-sigtc/(fac*fac)
4891 C Following variable is sigma(t_c)**(-2)
4892 sigcsq=sigcsq*sigcsq
4894 sig0inv=1.0D0/sig0i**2
4895 delthec=thetai-thet_pred_mean
4896 delthe0=thetai-theta0i
4897 term1=-0.5D0*sigcsq*delthec*delthec
4898 term2=-0.5D0*sig0inv*delthe0*delthe0
4899 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
4900 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4901 C NaNs in taking the logarithm. We extract the largest exponent which is added
4902 C to the energy (this being the log of the distribution) at the end of energy
4903 C term evaluation for this virtual-bond angle.
4904 if (term1.gt.term2) then
4906 term2=dexp(term2-termm)
4910 term1=dexp(term1-termm)
4913 C The ratio between the gamma-independent and gamma-dependent lobes of
4914 C the distribution is a Gaussian function of thet_pred_mean too.
4915 diffak=gthet(2,it)-thet_pred_mean
4916 ratak=diffak/gthet(3,it)**2
4917 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4918 C Let's differentiate it in thet_pred_mean NOW.
4920 C Now put together the distribution terms to make complete distribution.
4921 termexp=term1+ak*term2
4922 termpre=sigc+ak*sig0i
4923 C Contribution of the bending energy from this theta is just the -log of
4924 C the sum of the contributions from the two lobes and the pre-exponential
4925 C factor. Simple enough, isn't it?
4926 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4927 C write (iout,*) 'termexp',termexp,termm,termpre,i
4928 C NOW the derivatives!!!
4929 C 6/6/97 Take into account the deformation.
4930 E_theta=(delthec*sigcsq*term1
4931 & +ak*delthe0*sig0inv*term2)/termexp
4932 E_tc=((sigtc+aktc*sig0i)/termpre
4933 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4934 & aktc*term2)/termexp)
4937 c-----------------------------------------------------------------------------
4938 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4939 implicit real*8 (a-h,o-z)
4940 include 'DIMENSIONS'
4941 include 'COMMON.LOCAL'
4942 include 'COMMON.IOUNITS'
4943 common /calcthet/ term1,term2,termm,diffak,ratak,
4944 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4945 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4946 delthec=thetai-thet_pred_mean
4947 delthe0=thetai-theta0i
4948 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4949 t3 = thetai-thet_pred_mean
4953 t14 = t12+t6*sigsqtc
4955 t21 = thetai-theta0i
4961 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4962 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4963 & *(-t12*t9-ak*sig0inv*t27)
4967 C--------------------------------------------------------------------------
4968 subroutine ebend(etheta)
4970 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4971 C angles gamma and its derivatives in consecutive thetas and gammas.
4972 C ab initio-derived potentials from
4973 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4975 implicit real*8 (a-h,o-z)
4976 include 'DIMENSIONS'
4977 include 'COMMON.LOCAL'
4978 include 'COMMON.GEO'
4979 include 'COMMON.INTERACT'
4980 include 'COMMON.DERIV'
4981 include 'COMMON.VAR'
4982 include 'COMMON.CHAIN'
4983 include 'COMMON.IOUNITS'
4984 include 'COMMON.NAMES'
4985 include 'COMMON.FFIELD'
4986 include 'COMMON.CONTROL'
4987 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4988 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4989 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4990 & sinph1ph2(maxdouble,maxdouble)
4991 logical lprn /.false./, lprn1 /.false./
4993 do i=ithet_start,ithet_end
4994 c print *,i,itype(i-1),itype(i),itype(i-2)
4995 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4996 & .or.itype(i).eq.ntyp1) cycle
4997 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
4999 if (iabs(itype(i+1)).eq.20) iblock=2
5000 if (iabs(itype(i+1)).ne.20) iblock=1
5004 theti2=0.5d0*theta(i)
5005 ityp2=ithetyp((itype(i-1)))
5007 coskt(k)=dcos(k*theti2)
5008 sinkt(k)=dsin(k*theti2)
5010 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5013 if (phii.ne.phii) phii=150.0
5017 ityp1=ithetyp((itype(i-2)))
5018 C propagation of chirality for glycine type
5020 cosph1(k)=dcos(k*phii)
5021 sinph1(k)=dsin(k*phii)
5031 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5034 if (phii1.ne.phii1) phii1=150.0
5039 ityp3=ithetyp((itype(i)))
5041 cosph2(k)=dcos(k*phii1)
5042 sinph2(k)=dsin(k*phii1)
5052 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5055 ccl=cosph1(l)*cosph2(k-l)
5056 ssl=sinph1(l)*sinph2(k-l)
5057 scl=sinph1(l)*cosph2(k-l)
5058 csl=cosph1(l)*sinph2(k-l)
5059 cosph1ph2(l,k)=ccl-ssl
5060 cosph1ph2(k,l)=ccl+ssl
5061 sinph1ph2(l,k)=scl+csl
5062 sinph1ph2(k,l)=scl-csl
5066 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5067 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5068 write (iout,*) "coskt and sinkt"
5070 write (iout,*) k,coskt(k),sinkt(k)
5074 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5075 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5078 & write (iout,*) "k",k,"
5079 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5080 & " ethetai",ethetai
5083 write (iout,*) "cosph and sinph"
5085 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5087 write (iout,*) "cosph1ph2 and sinph2ph2"
5090 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5091 & sinph1ph2(l,k),sinph1ph2(k,l)
5094 write(iout,*) "ethetai",ethetai
5098 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5099 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5100 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5101 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5102 ethetai=ethetai+sinkt(m)*aux
5103 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5104 dephii=dephii+k*sinkt(m)*(
5105 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5106 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5107 dephii1=dephii1+k*sinkt(m)*(
5108 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5109 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5111 & write (iout,*) "m",m," k",k," bbthet",
5112 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5113 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5114 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5115 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5119 & write(iout,*) "ethetai",ethetai
5123 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5124 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5125 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5126 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5127 ethetai=ethetai+sinkt(m)*aux
5128 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5129 dephii=dephii+l*sinkt(m)*(
5130 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5131 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5132 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5133 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5134 dephii1=dephii1+(k-l)*sinkt(m)*(
5135 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5136 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5137 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5138 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5140 write (iout,*) "m",m," k",k," l",l," ffthet",
5141 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5142 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5143 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5144 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5145 & " ethetai",ethetai
5146 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5147 & cosph1ph2(k,l)*sinkt(m),
5148 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5156 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5157 & i,theta(i)*rad2deg,phii*rad2deg,
5158 & phii1*rad2deg,ethetai
5160 etheta=etheta+ethetai
5161 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5162 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5163 gloc(nphi+i-2,icg)=wang*dethetai+ gloc(nphi+i-2,icg)
5169 c-----------------------------------------------------------------------------
5170 subroutine esc(escloc)
5171 C Calculate the local energy of a side chain and its derivatives in the
5172 C corresponding virtual-bond valence angles THETA and the spherical angles
5174 implicit real*8 (a-h,o-z)
5175 include 'DIMENSIONS'
5176 include 'COMMON.GEO'
5177 include 'COMMON.LOCAL'
5178 include 'COMMON.VAR'
5179 include 'COMMON.INTERACT'
5180 include 'COMMON.DERIV'
5181 include 'COMMON.CHAIN'
5182 include 'COMMON.IOUNITS'
5183 include 'COMMON.NAMES'
5184 include 'COMMON.FFIELD'
5185 include 'COMMON.CONTROL'
5186 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5187 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5188 common /sccalc/ time11,time12,time112,theti,it,nlobit
5191 c write (iout,'(a)') 'ESC'
5192 do i=loc_start,loc_end
5194 if (it.eq.ntyp1) cycle
5195 if (it.eq.10) goto 1
5196 nlobit=nlob(iabs(it))
5197 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5198 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5199 theti=theta(i+1)-pipol
5204 if (x(2).gt.pi-delta) then
5208 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5210 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5211 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5213 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5214 & ddersc0(1),dersc(1))
5215 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5216 & ddersc0(3),dersc(3))
5218 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5220 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5221 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5222 & dersc0(2),esclocbi,dersc02)
5223 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5225 call splinthet(x(2),0.5d0*delta,ss,ssd)
5230 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5232 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5233 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5235 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5237 c write (iout,*) escloci
5238 else if (x(2).lt.delta) then
5242 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5244 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5245 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5247 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5248 & ddersc0(1),dersc(1))
5249 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5250 & ddersc0(3),dersc(3))
5252 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5254 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5255 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5256 & dersc0(2),esclocbi,dersc02)
5257 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5262 call splinthet(x(2),0.5d0*delta,ss,ssd)
5264 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5266 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5267 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5269 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5270 c write (iout,*) escloci
5272 call enesc(x,escloci,dersc,ddummy,.false.)
5275 escloc=escloc+escloci
5276 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5277 & 'escloc',i,escloci
5278 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5280 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5282 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5283 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5288 C---------------------------------------------------------------------------
5289 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5290 implicit real*8 (a-h,o-z)
5291 include 'DIMENSIONS'
5292 include 'COMMON.GEO'
5293 include 'COMMON.LOCAL'
5294 include 'COMMON.IOUNITS'
5295 common /sccalc/ time11,time12,time112,theti,it,nlobit
5296 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5297 double precision contr(maxlob,-1:1)
5299 c write (iout,*) 'it=',it,' nlobit=',nlobit
5303 if (mixed) ddersc(j)=0.0d0
5307 C Because of periodicity of the dependence of the SC energy in omega we have
5308 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5309 C To avoid underflows, first compute & store the exponents.
5317 z(k)=x(k)-censc(k,j,it)
5322 Axk=Axk+gaussc(l,k,j,it)*z(l)
5328 expfac=expfac+Ax(k,j,iii)*z(k)
5336 C As in the case of ebend, we want to avoid underflows in exponentiation and
5337 C subsequent NaNs and INFs in energy calculation.
5338 C Find the largest exponent
5342 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5346 cd print *,'it=',it,' emin=',emin
5348 C Compute the contribution to SC energy and derivatives
5353 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5354 if(adexp.ne.adexp) adexp=1.0
5357 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5359 cd print *,'j=',j,' expfac=',expfac
5360 escloc_i=escloc_i+expfac
5362 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5366 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5367 & +gaussc(k,2,j,it))*expfac
5374 dersc(1)=dersc(1)/cos(theti)**2
5375 ddersc(1)=ddersc(1)/cos(theti)**2
5378 escloci=-(dlog(escloc_i)-emin)
5380 dersc(j)=dersc(j)/escloc_i
5384 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5389 C------------------------------------------------------------------------------
5390 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5391 implicit real*8 (a-h,o-z)
5392 include 'DIMENSIONS'
5393 include 'COMMON.GEO'
5394 include 'COMMON.LOCAL'
5395 include 'COMMON.IOUNITS'
5396 common /sccalc/ time11,time12,time112,theti,it,nlobit
5397 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5398 double precision contr(maxlob)
5409 z(k)=x(k)-censc(k,j,it)
5415 Axk=Axk+gaussc(l,k,j,it)*z(l)
5421 expfac=expfac+Ax(k,j)*z(k)
5426 C As in the case of ebend, we want to avoid underflows in exponentiation and
5427 C subsequent NaNs and INFs in energy calculation.
5428 C Find the largest exponent
5431 if (emin.gt.contr(j)) emin=contr(j)
5435 C Compute the contribution to SC energy and derivatives
5439 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5440 escloc_i=escloc_i+expfac
5442 dersc(k)=dersc(k)+Ax(k,j)*expfac
5444 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5445 & +gaussc(1,2,j,it))*expfac
5449 dersc(1)=dersc(1)/cos(theti)**2
5450 dersc12=dersc12/cos(theti)**2
5451 escloci=-(dlog(escloc_i)-emin)
5453 dersc(j)=dersc(j)/escloc_i
5455 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5459 c----------------------------------------------------------------------------------
5460 subroutine esc(escloc)
5461 C Calculate the local energy of a side chain and its derivatives in the
5462 C corresponding virtual-bond valence angles THETA and the spherical angles
5463 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5464 C added by Urszula Kozlowska. 07/11/2007
5466 implicit real*8 (a-h,o-z)
5467 include 'DIMENSIONS'
5468 include 'COMMON.GEO'
5469 include 'COMMON.LOCAL'
5470 include 'COMMON.VAR'
5471 include 'COMMON.SCROT'
5472 include 'COMMON.INTERACT'
5473 include 'COMMON.DERIV'
5474 include 'COMMON.CHAIN'
5475 include 'COMMON.IOUNITS'
5476 include 'COMMON.NAMES'
5477 include 'COMMON.FFIELD'
5478 include 'COMMON.CONTROL'
5479 include 'COMMON.VECTORS'
5480 double precision x_prime(3),y_prime(3),z_prime(3)
5481 & , sumene,dsc_i,dp2_i,x(65),
5482 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5483 & de_dxx,de_dyy,de_dzz,de_dt
5484 double precision s1_t,s1_6_t,s2_t,s2_6_t
5486 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5487 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5488 & dt_dCi(3),dt_dCi1(3)
5489 common /sccalc/ time11,time12,time112,theti,it,nlobit
5492 do i=loc_start,loc_end
5493 if (itype(i).eq.ntyp1) cycle
5494 costtab(i+1) =dcos(theta(i+1))
5495 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5496 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5497 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5498 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5499 cosfac=dsqrt(cosfac2)
5500 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5501 sinfac=dsqrt(sinfac2)
5503 if (it.eq.10) goto 1
5505 C Compute the axes of tghe local cartesian coordinates system; store in
5506 c x_prime, y_prime and z_prime
5513 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5514 C & dc_norm(3,i+nres)
5516 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5517 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5520 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5523 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5524 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5525 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5526 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5527 c & " xy",scalar(x_prime(1),y_prime(1)),
5528 c & " xz",scalar(x_prime(1),z_prime(1)),
5529 c & " yy",scalar(y_prime(1),y_prime(1)),
5530 c & " yz",scalar(y_prime(1),z_prime(1)),
5531 c & " zz",scalar(z_prime(1),z_prime(1))
5533 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5534 C to local coordinate system. Store in xx, yy, zz.
5540 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5541 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5542 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5549 C Compute the energy of the ith side cbain
5551 c write (2,*) "xx",xx," yy",yy," zz",zz
5554 x(j) = sc_parmin(j,it)
5557 Cc diagnostics - remove later
5559 yy1 = dsin(alph(2))*dcos(omeg(2))
5560 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5561 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5562 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5564 C," --- ", xx_w,yy_w,zz_w
5567 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5568 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5570 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5571 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5573 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5574 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5575 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5576 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5577 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5579 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5580 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5581 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5582 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5583 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5585 dsc_i = 0.743d0+x(61)
5587 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5588 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5589 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5590 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5591 s1=(1+x(63))/(0.1d0 + dscp1)
5592 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5593 s2=(1+x(65))/(0.1d0 + dscp2)
5594 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5595 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5596 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5597 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5599 c & dscp1,dscp2,sumene
5600 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5601 escloc = escloc + sumene
5602 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5607 C This section to check the numerical derivatives of the energy of ith side
5608 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5609 C #define DEBUG in the code to turn it on.
5611 write (2,*) "sumene =",sumene
5615 write (2,*) xx,yy,zz
5616 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5617 de_dxx_num=(sumenep-sumene)/aincr
5619 write (2,*) "xx+ sumene from enesc=",sumenep
5622 write (2,*) xx,yy,zz
5623 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5624 de_dyy_num=(sumenep-sumene)/aincr
5626 write (2,*) "yy+ sumene from enesc=",sumenep
5629 write (2,*) xx,yy,zz
5630 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5631 de_dzz_num=(sumenep-sumene)/aincr
5633 write (2,*) "zz+ sumene from enesc=",sumenep
5634 costsave=cost2tab(i+1)
5635 sintsave=sint2tab(i+1)
5636 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5637 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5638 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5639 de_dt_num=(sumenep-sumene)/aincr
5640 write (2,*) " t+ sumene from enesc=",sumenep
5641 cost2tab(i+1)=costsave
5642 sint2tab(i+1)=sintsave
5643 C End of diagnostics section.
5646 C Compute the gradient of esc
5648 c zz=zz*dsign(1.0,dfloat(itype(i)))
5649 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5650 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5651 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5652 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5653 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5654 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5655 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5656 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5657 pom1=(sumene3*sint2tab(i+1)+sumene1)
5658 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5659 pom2=(sumene4*cost2tab(i+1)+sumene2)
5660 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5661 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5662 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5663 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5665 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5666 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5667 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5669 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5670 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5671 & +(pom1+pom2)*pom_dx
5673 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5676 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5677 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5678 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5680 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5681 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5682 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5683 & +x(59)*zz**2 +x(60)*xx*zz
5684 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5685 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5686 & +(pom1-pom2)*pom_dy
5688 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5691 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5692 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5693 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5694 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5695 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5696 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5697 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5698 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5700 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5703 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5704 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5705 & +pom1*pom_dt1+pom2*pom_dt2
5707 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5712 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5713 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5714 cosfac2xx=cosfac2*xx
5715 sinfac2yy=sinfac2*yy
5717 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5719 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5721 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5722 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5723 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5724 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5725 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5726 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5727 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5728 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5729 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5730 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5734 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5735 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5736 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5737 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5740 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5741 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5742 dZZ_XYZ(k)=vbld_inv(i+nres)*
5743 & (z_prime(k)-zz*dC_norm(k,i+nres))
5745 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5746 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5750 dXX_Ctab(k,i)=dXX_Ci(k)
5751 dXX_C1tab(k,i)=dXX_Ci1(k)
5752 dYY_Ctab(k,i)=dYY_Ci(k)
5753 dYY_C1tab(k,i)=dYY_Ci1(k)
5754 dZZ_Ctab(k,i)=dZZ_Ci(k)
5755 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5756 dXX_XYZtab(k,i)=dXX_XYZ(k)
5757 dYY_XYZtab(k,i)=dYY_XYZ(k)
5758 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5762 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5763 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5764 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5765 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5766 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5768 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5769 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5770 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5771 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5772 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5773 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5774 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5775 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5777 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5778 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5780 C to check gradient call subroutine check_grad
5786 c------------------------------------------------------------------------------
5787 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5789 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5790 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5791 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5792 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5794 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5795 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5797 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5798 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5799 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5800 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5801 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5803 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5804 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5805 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5806 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5807 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5809 dsc_i = 0.743d0+x(61)
5811 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5812 & *(xx*cost2+yy*sint2))
5813 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5814 & *(xx*cost2-yy*sint2))
5815 s1=(1+x(63))/(0.1d0 + dscp1)
5816 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5817 s2=(1+x(65))/(0.1d0 + dscp2)
5818 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5819 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5820 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5825 c------------------------------------------------------------------------------
5826 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5828 C This procedure calculates two-body contact function g(rij) and its derivative:
5831 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5834 C where x=(rij-r0ij)/delta
5836 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5839 double precision rij,r0ij,eps0ij,fcont,fprimcont
5840 double precision x,x2,x4,delta
5844 if (x.lt.-1.0D0) then
5847 else if (x.le.1.0D0) then
5850 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5851 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5858 c------------------------------------------------------------------------------
5859 subroutine splinthet(theti,delta,ss,ssder)
5860 implicit real*8 (a-h,o-z)
5861 include 'DIMENSIONS'
5862 include 'COMMON.VAR'
5863 include 'COMMON.GEO'
5866 if (theti.gt.pipol) then
5867 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5869 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5874 c------------------------------------------------------------------------------
5875 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5877 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5878 double precision ksi,ksi2,ksi3,a1,a2,a3
5879 a1=fprim0*delta/(f1-f0)
5885 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5886 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5889 c------------------------------------------------------------------------------
5890 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5892 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5893 double precision ksi,ksi2,ksi3,a1,a2,a3
5898 a2=3*(f1x-f0x)-2*fprim0x*delta
5899 a3=fprim0x*delta-2*(f1x-f0x)
5900 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5903 C-----------------------------------------------------------------------------
5905 C-----------------------------------------------------------------------------
5906 subroutine etor(etors,edihcnstr)
5907 implicit real*8 (a-h,o-z)
5908 include 'DIMENSIONS'
5909 include 'COMMON.VAR'
5910 include 'COMMON.GEO'
5911 include 'COMMON.LOCAL'
5912 include 'COMMON.TORSION'
5913 include 'COMMON.INTERACT'
5914 include 'COMMON.DERIV'
5915 include 'COMMON.CHAIN'
5916 include 'COMMON.NAMES'
5917 include 'COMMON.IOUNITS'
5918 include 'COMMON.FFIELD'
5919 include 'COMMON.TORCNSTR'
5920 include 'COMMON.CONTROL'
5922 C Set lprn=.true. for debugging
5926 do i=iphi_start,iphi_end
5928 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5929 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5930 itori=itortyp(itype(i-2))
5931 itori1=itortyp(itype(i-1))
5934 C Proline-Proline pair is a special case...
5935 if (itori.eq.3 .and. itori1.eq.3) then
5936 if (phii.gt.-dwapi3) then
5938 fac=1.0D0/(1.0D0-cosphi)
5939 etorsi=v1(1,3,3)*fac
5940 etorsi=etorsi+etorsi
5941 etors=etors+etorsi-v1(1,3,3)
5942 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5943 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5946 v1ij=v1(j+1,itori,itori1)
5947 v2ij=v2(j+1,itori,itori1)
5950 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5951 if (energy_dec) etors_ii=etors_ii+
5952 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5953 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5957 v1ij=v1(j,itori,itori1)
5958 v2ij=v2(j,itori,itori1)
5961 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5962 if (energy_dec) etors_ii=etors_ii+
5963 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5964 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5967 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5970 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5971 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5972 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5973 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5974 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5976 ! 6/20/98 - dihedral angle constraints
5979 itori=idih_constr(i)
5982 if (difi.gt.drange(i)) then
5984 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5985 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5986 else if (difi.lt.-drange(i)) then
5988 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5989 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5991 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5992 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5994 ! write (iout,*) 'edihcnstr',edihcnstr
5997 c------------------------------------------------------------------------------
5998 subroutine etor_d(etors_d)
6002 c----------------------------------------------------------------------------
6004 subroutine etor(etors,edihcnstr)
6005 implicit real*8 (a-h,o-z)
6006 include 'DIMENSIONS'
6007 include 'COMMON.VAR'
6008 include 'COMMON.GEO'
6009 include 'COMMON.LOCAL'
6010 include 'COMMON.TORSION'
6011 include 'COMMON.INTERACT'
6012 include 'COMMON.DERIV'
6013 include 'COMMON.CHAIN'
6014 include 'COMMON.NAMES'
6015 include 'COMMON.IOUNITS'
6016 include 'COMMON.FFIELD'
6017 include 'COMMON.TORCNSTR'
6018 include 'COMMON.CONTROL'
6020 C Set lprn=.true. for debugging
6024 do i=iphi_start,iphi_end
6025 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6026 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6027 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6028 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6029 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6030 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6031 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6032 C For introducing the NH3+ and COO- group please check the etor_d for reference
6035 if (iabs(itype(i)).eq.20) then
6040 itori=itortyp(itype(i-2))
6041 itori1=itortyp(itype(i-1))
6044 C Regular cosine and sine terms
6045 do j=1,nterm(itori,itori1,iblock)
6046 v1ij=v1(j,itori,itori1,iblock)
6047 v2ij=v2(j,itori,itori1,iblock)
6050 etors=etors+v1ij*cosphi+v2ij*sinphi
6051 if (energy_dec) etors_ii=etors_ii+
6052 & v1ij*cosphi+v2ij*sinphi
6053 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6057 C E = SUM ----------------------------------- - v1
6058 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6060 cosphi=dcos(0.5d0*phii)
6061 sinphi=dsin(0.5d0*phii)
6062 do j=1,nlor(itori,itori1,iblock)
6063 vl1ij=vlor1(j,itori,itori1)
6064 vl2ij=vlor2(j,itori,itori1)
6065 vl3ij=vlor3(j,itori,itori1)
6066 pom=vl2ij*cosphi+vl3ij*sinphi
6067 pom1=1.0d0/(pom*pom+1.0d0)
6068 etors=etors+vl1ij*pom1
6069 if (energy_dec) etors_ii=etors_ii+
6072 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6074 C Subtract the constant term
6075 etors=etors-v0(itori,itori1,iblock)
6076 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6077 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6079 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6080 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6081 & (v1(j,itori,itori1,iblock),j=1,6),
6082 & (v2(j,itori,itori1,iblock),j=1,6)
6083 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6084 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6086 ! 6/20/98 - dihedral angle constraints
6088 c do i=1,ndih_constr
6089 do i=idihconstr_start,idihconstr_end
6090 itori=idih_constr(i)
6092 difi=pinorm(phii-phi0(i))
6093 if (difi.gt.drange(i)) then
6095 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6096 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6097 else if (difi.lt.-drange(i)) then
6099 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6100 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6104 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6105 cd & rad2deg*phi0(i), rad2deg*drange(i),
6106 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6108 cd write (iout,*) 'edihcnstr',edihcnstr
6111 c----------------------------------------------------------------------------
6112 subroutine etor_d(etors_d)
6113 C 6/23/01 Compute double torsional energy
6114 implicit real*8 (a-h,o-z)
6115 include 'DIMENSIONS'
6116 include 'COMMON.VAR'
6117 include 'COMMON.GEO'
6118 include 'COMMON.LOCAL'
6119 include 'COMMON.TORSION'
6120 include 'COMMON.INTERACT'
6121 include 'COMMON.DERIV'
6122 include 'COMMON.CHAIN'
6123 include 'COMMON.NAMES'
6124 include 'COMMON.IOUNITS'
6125 include 'COMMON.FFIELD'
6126 include 'COMMON.TORCNSTR'
6128 C Set lprn=.true. for debugging
6132 c write(iout,*) "a tu??"
6133 do i=iphid_start,iphid_end
6134 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6135 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6136 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6137 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6138 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6139 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6140 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6141 & (itype(i+1).eq.ntyp1)) cycle
6142 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6143 itori=itortyp(itype(i-2))
6144 itori1=itortyp(itype(i-1))
6145 itori2=itortyp(itype(i))
6151 if (iabs(itype(i+1)).eq.20) iblock=2
6152 C Iblock=2 Proline type
6153 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6154 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6155 C if (itype(i+1).eq.ntyp1) iblock=3
6156 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6157 C IS or IS NOT need for this
6158 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6159 C is (itype(i-3).eq.ntyp1) ntblock=2
6160 C ntblock is N-terminal blocking group
6162 C Regular cosine and sine terms
6163 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6164 C Example of changes for NH3+ blocking group
6165 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6166 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6167 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6168 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6169 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6170 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6171 cosphi1=dcos(j*phii)
6172 sinphi1=dsin(j*phii)
6173 cosphi2=dcos(j*phii1)
6174 sinphi2=dsin(j*phii1)
6175 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6176 & v2cij*cosphi2+v2sij*sinphi2
6177 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6178 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6180 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6182 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6183 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6184 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6185 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6186 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6187 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6188 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6189 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6190 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6191 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6192 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6193 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6194 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6195 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6198 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6199 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6204 c------------------------------------------------------------------------------
6205 subroutine eback_sc_corr(esccor)
6206 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6207 c conformational states; temporarily implemented as differences
6208 c between UNRES torsional potentials (dependent on three types of
6209 c residues) and the torsional potentials dependent on all 20 types
6210 c of residues computed from AM1 energy surfaces of terminally-blocked
6211 c amino-acid residues.
6212 implicit real*8 (a-h,o-z)
6213 include 'DIMENSIONS'
6214 include 'COMMON.VAR'
6215 include 'COMMON.GEO'
6216 include 'COMMON.LOCAL'
6217 include 'COMMON.TORSION'
6218 include 'COMMON.SCCOR'
6219 include 'COMMON.INTERACT'
6220 include 'COMMON.DERIV'
6221 include 'COMMON.CHAIN'
6222 include 'COMMON.NAMES'
6223 include 'COMMON.IOUNITS'
6224 include 'COMMON.FFIELD'
6225 include 'COMMON.CONTROL'
6227 C Set lprn=.true. for debugging
6230 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6232 do i=itau_start,itau_end
6233 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6235 isccori=isccortyp(itype(i-2))
6236 isccori1=isccortyp(itype(i-1))
6237 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6239 do intertyp=1,3 !intertyp
6240 cc Added 09 May 2012 (Adasko)
6241 cc Intertyp means interaction type of backbone mainchain correlation:
6242 c 1 = SC...Ca...Ca...Ca
6243 c 2 = Ca...Ca...Ca...SC
6244 c 3 = SC...Ca...Ca...SCi
6246 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6247 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6248 & (itype(i-1).eq.ntyp1)))
6249 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6250 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6251 & .or.(itype(i).eq.ntyp1)))
6252 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6253 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6254 & (itype(i-3).eq.ntyp1)))) cycle
6255 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6256 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6258 do j=1,nterm_sccor(isccori,isccori1)
6259 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6260 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6261 cosphi=dcos(j*tauangle(intertyp,i))
6262 sinphi=dsin(j*tauangle(intertyp,i))
6263 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6264 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6266 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6267 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6269 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6270 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6271 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6272 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6273 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6279 c----------------------------------------------------------------------------
6280 subroutine multibody(ecorr)
6281 C This subroutine calculates multi-body contributions to energy following
6282 C the idea of Skolnick et al. If side chains I and J make a contact and
6283 C at the same time side chains I+1 and J+1 make a contact, an extra
6284 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6285 implicit real*8 (a-h,o-z)
6286 include 'DIMENSIONS'
6287 include 'COMMON.IOUNITS'
6288 include 'COMMON.DERIV'
6289 include 'COMMON.INTERACT'
6290 include 'COMMON.CONTACTS'
6291 double precision gx(3),gx1(3)
6294 C Set lprn=.true. for debugging
6298 write (iout,'(a)') 'Contact function values:'
6300 write (iout,'(i2,20(1x,i2,f10.5))')
6301 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6316 num_conti=num_cont(i)
6317 num_conti1=num_cont(i1)
6322 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6323 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6324 cd & ' ishift=',ishift
6325 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6326 C The system gains extra energy.
6327 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6328 endif ! j1==j+-ishift
6337 c------------------------------------------------------------------------------
6338 double precision function esccorr(i,j,k,l,jj,kk)
6339 implicit real*8 (a-h,o-z)
6340 include 'DIMENSIONS'
6341 include 'COMMON.IOUNITS'
6342 include 'COMMON.DERIV'
6343 include 'COMMON.INTERACT'
6344 include 'COMMON.CONTACTS'
6345 double precision gx(3),gx1(3)
6350 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6351 C Calculate the multi-body contribution to energy.
6352 C Calculate multi-body contributions to the gradient.
6353 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6354 cd & k,l,(gacont(m,kk,k),m=1,3)
6356 gx(m) =ekl*gacont(m,jj,i)
6357 gx1(m)=eij*gacont(m,kk,k)
6358 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6359 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6360 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6361 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6365 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6370 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6376 c------------------------------------------------------------------------------
6377 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6378 C This subroutine calculates multi-body contributions to hydrogen-bonding
6379 implicit real*8 (a-h,o-z)
6380 include 'DIMENSIONS'
6381 include 'COMMON.IOUNITS'
6384 parameter (max_cont=maxconts)
6385 parameter (max_dim=26)
6386 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6387 double precision zapas(max_dim,maxconts,max_fg_procs),
6388 & zapas_recv(max_dim,maxconts,max_fg_procs)
6389 common /przechowalnia/ zapas
6390 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6391 & status_array(MPI_STATUS_SIZE,maxconts*2)
6393 include 'COMMON.SETUP'
6394 include 'COMMON.FFIELD'
6395 include 'COMMON.DERIV'
6396 include 'COMMON.INTERACT'
6397 include 'COMMON.CONTACTS'
6398 include 'COMMON.CONTROL'
6399 include 'COMMON.LOCAL'
6400 double precision gx(3),gx1(3),time00
6403 C Set lprn=.true. for debugging
6408 if (nfgtasks.le.1) goto 30
6410 write (iout,'(a)') 'Contact function values before RECEIVE:'
6412 write (iout,'(2i3,50(1x,i2,f5.2))')
6413 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6414 & j=1,num_cont_hb(i))
6418 do i=1,ntask_cont_from
6421 do i=1,ntask_cont_to
6424 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6426 C Make the list of contacts to send to send to other procesors
6427 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6429 do i=iturn3_start,iturn3_end
6430 c write (iout,*) "make contact list turn3",i," num_cont",
6432 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6434 do i=iturn4_start,iturn4_end
6435 c write (iout,*) "make contact list turn4",i," num_cont",
6437 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6441 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6443 do j=1,num_cont_hb(i)
6446 iproc=iint_sent_local(k,jjc,ii)
6447 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6448 if (iproc.gt.0) then
6449 ncont_sent(iproc)=ncont_sent(iproc)+1
6450 nn=ncont_sent(iproc)
6452 zapas(2,nn,iproc)=jjc
6453 zapas(3,nn,iproc)=facont_hb(j,i)
6454 zapas(4,nn,iproc)=ees0p(j,i)
6455 zapas(5,nn,iproc)=ees0m(j,i)
6456 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6457 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6458 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6459 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6460 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6461 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6462 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6463 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6464 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6465 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6466 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6467 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6468 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6469 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6470 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6471 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6472 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6473 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6474 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6475 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6476 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6483 & "Numbers of contacts to be sent to other processors",
6484 & (ncont_sent(i),i=1,ntask_cont_to)
6485 write (iout,*) "Contacts sent"
6486 do ii=1,ntask_cont_to
6488 iproc=itask_cont_to(ii)
6489 write (iout,*) nn," contacts to processor",iproc,
6490 & " of CONT_TO_COMM group"
6492 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6500 CorrelID1=nfgtasks+fg_rank+1
6502 C Receive the numbers of needed contacts from other processors
6503 do ii=1,ntask_cont_from
6504 iproc=itask_cont_from(ii)
6506 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6507 & FG_COMM,req(ireq),IERR)
6509 c write (iout,*) "IRECV ended"
6511 C Send the number of contacts needed by other processors
6512 do ii=1,ntask_cont_to
6513 iproc=itask_cont_to(ii)
6515 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6516 & FG_COMM,req(ireq),IERR)
6518 c write (iout,*) "ISEND ended"
6519 c write (iout,*) "number of requests (nn)",ireq
6522 & call MPI_Waitall(ireq,req,status_array,ierr)
6524 c & "Numbers of contacts to be received from other processors",
6525 c & (ncont_recv(i),i=1,ntask_cont_from)
6529 do ii=1,ntask_cont_from
6530 iproc=itask_cont_from(ii)
6532 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6533 c & " of CONT_TO_COMM group"
6537 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6538 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6539 c write (iout,*) "ireq,req",ireq,req(ireq)
6542 C Send the contacts to processors that need them
6543 do ii=1,ntask_cont_to
6544 iproc=itask_cont_to(ii)
6546 c write (iout,*) nn," contacts to processor",iproc,
6547 c & " of CONT_TO_COMM group"
6550 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6551 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6552 c write (iout,*) "ireq,req",ireq,req(ireq)
6554 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6558 c write (iout,*) "number of requests (contacts)",ireq
6559 c write (iout,*) "req",(req(i),i=1,4)
6562 & call MPI_Waitall(ireq,req,status_array,ierr)
6563 do iii=1,ntask_cont_from
6564 iproc=itask_cont_from(iii)
6567 write (iout,*) "Received",nn," contacts from processor",iproc,
6568 & " of CONT_FROM_COMM group"
6571 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6576 ii=zapas_recv(1,i,iii)
6577 c Flag the received contacts to prevent double-counting
6578 jj=-zapas_recv(2,i,iii)
6579 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6581 nnn=num_cont_hb(ii)+1
6584 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6585 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6586 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6587 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6588 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6589 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6590 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6591 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6592 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6593 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6594 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6595 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6596 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6597 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6598 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6599 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6600 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6601 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6602 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6603 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6604 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6605 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6606 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6607 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6612 write (iout,'(a)') 'Contact function values after receive:'
6614 write (iout,'(2i3,50(1x,i3,f5.2))')
6615 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6616 & j=1,num_cont_hb(i))
6623 write (iout,'(a)') 'Contact function values:'
6625 write (iout,'(2i3,50(1x,i3,f5.2))')
6626 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6627 & j=1,num_cont_hb(i))
6631 C Remove the loop below after debugging !!!
6638 C Calculate the local-electrostatic correlation terms
6639 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6641 num_conti=num_cont_hb(i)
6642 num_conti1=num_cont_hb(i+1)
6649 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6650 c & ' jj=',jj,' kk=',kk
6651 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6652 & .or. j.lt.0 .and. j1.gt.0) .and.
6653 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6654 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6655 C The system gains extra energy.
6656 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6657 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6658 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6660 else if (j1.eq.j) then
6661 C Contacts I-J and I-(J+1) occur simultaneously.
6662 C The system loses extra energy.
6663 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6668 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6669 c & ' jj=',jj,' kk=',kk
6671 C Contacts I-J and (I+1)-J occur simultaneously.
6672 C The system loses extra energy.
6673 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6680 c------------------------------------------------------------------------------
6681 subroutine add_hb_contact(ii,jj,itask)
6682 implicit real*8 (a-h,o-z)
6683 include "DIMENSIONS"
6684 include "COMMON.IOUNITS"
6687 parameter (max_cont=maxconts)
6688 parameter (max_dim=26)
6689 include "COMMON.CONTACTS"
6690 double precision zapas(max_dim,maxconts,max_fg_procs),
6691 & zapas_recv(max_dim,maxconts,max_fg_procs)
6692 common /przechowalnia/ zapas
6693 integer i,j,ii,jj,iproc,itask(4),nn
6694 c write (iout,*) "itask",itask
6697 if (iproc.gt.0) then
6698 do j=1,num_cont_hb(ii)
6700 c write (iout,*) "i",ii," j",jj," jjc",jjc
6702 ncont_sent(iproc)=ncont_sent(iproc)+1
6703 nn=ncont_sent(iproc)
6704 zapas(1,nn,iproc)=ii
6705 zapas(2,nn,iproc)=jjc
6706 zapas(3,nn,iproc)=facont_hb(j,ii)
6707 zapas(4,nn,iproc)=ees0p(j,ii)
6708 zapas(5,nn,iproc)=ees0m(j,ii)
6709 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6710 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6711 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6712 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6713 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6714 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6715 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6716 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6717 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6718 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6719 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6720 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6721 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6722 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6723 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6724 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6725 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6726 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6727 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6728 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6729 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6737 c------------------------------------------------------------------------------
6738 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6740 C This subroutine calculates multi-body contributions to hydrogen-bonding
6741 implicit real*8 (a-h,o-z)
6742 include 'DIMENSIONS'
6743 include 'COMMON.IOUNITS'
6746 parameter (max_cont=maxconts)
6747 parameter (max_dim=70)
6748 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6749 double precision zapas(max_dim,maxconts,max_fg_procs),
6750 & zapas_recv(max_dim,maxconts,max_fg_procs)
6751 common /przechowalnia/ zapas
6752 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6753 & status_array(MPI_STATUS_SIZE,maxconts*2)
6755 include 'COMMON.SETUP'
6756 include 'COMMON.FFIELD'
6757 include 'COMMON.DERIV'
6758 include 'COMMON.LOCAL'
6759 include 'COMMON.INTERACT'
6760 include 'COMMON.CONTACTS'
6761 include 'COMMON.CHAIN'
6762 include 'COMMON.CONTROL'
6763 double precision gx(3),gx1(3)
6764 integer num_cont_hb_old(maxres)
6766 double precision eello4,eello5,eelo6,eello_turn6
6767 external eello4,eello5,eello6,eello_turn6
6768 C Set lprn=.true. for debugging
6773 num_cont_hb_old(i)=num_cont_hb(i)
6777 if (nfgtasks.le.1) goto 30
6779 write (iout,'(a)') 'Contact function values before RECEIVE:'
6781 write (iout,'(2i3,50(1x,i2,f5.2))')
6782 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6783 & j=1,num_cont_hb(i))
6787 do i=1,ntask_cont_from
6790 do i=1,ntask_cont_to
6793 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6795 C Make the list of contacts to send to send to other procesors
6796 do i=iturn3_start,iturn3_end
6797 c write (iout,*) "make contact list turn3",i," num_cont",
6799 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6801 do i=iturn4_start,iturn4_end
6802 c write (iout,*) "make contact list turn4",i," num_cont",
6804 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6808 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6810 do j=1,num_cont_hb(i)
6813 iproc=iint_sent_local(k,jjc,ii)
6814 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6815 if (iproc.ne.0) then
6816 ncont_sent(iproc)=ncont_sent(iproc)+1
6817 nn=ncont_sent(iproc)
6819 zapas(2,nn,iproc)=jjc
6820 zapas(3,nn,iproc)=d_cont(j,i)
6824 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6829 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6837 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6848 & "Numbers of contacts to be sent to other processors",
6849 & (ncont_sent(i),i=1,ntask_cont_to)
6850 write (iout,*) "Contacts sent"
6851 do ii=1,ntask_cont_to
6853 iproc=itask_cont_to(ii)
6854 write (iout,*) nn," contacts to processor",iproc,
6855 & " of CONT_TO_COMM group"
6857 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6865 CorrelID1=nfgtasks+fg_rank+1
6867 C Receive the numbers of needed contacts from other processors
6868 do ii=1,ntask_cont_from
6869 iproc=itask_cont_from(ii)
6871 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6872 & FG_COMM,req(ireq),IERR)
6874 c write (iout,*) "IRECV ended"
6876 C Send the number of contacts needed by other processors
6877 do ii=1,ntask_cont_to
6878 iproc=itask_cont_to(ii)
6880 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6881 & FG_COMM,req(ireq),IERR)
6883 c write (iout,*) "ISEND ended"
6884 c write (iout,*) "number of requests (nn)",ireq
6887 & call MPI_Waitall(ireq,req,status_array,ierr)
6889 c & "Numbers of contacts to be received from other processors",
6890 c & (ncont_recv(i),i=1,ntask_cont_from)
6894 do ii=1,ntask_cont_from
6895 iproc=itask_cont_from(ii)
6897 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6898 c & " of CONT_TO_COMM group"
6902 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6903 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6904 c write (iout,*) "ireq,req",ireq,req(ireq)
6907 C Send the contacts to processors that need them
6908 do ii=1,ntask_cont_to
6909 iproc=itask_cont_to(ii)
6911 c write (iout,*) nn," contacts to processor",iproc,
6912 c & " of CONT_TO_COMM group"
6915 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6916 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6917 c write (iout,*) "ireq,req",ireq,req(ireq)
6919 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6923 c write (iout,*) "number of requests (contacts)",ireq
6924 c write (iout,*) "req",(req(i),i=1,4)
6927 & call MPI_Waitall(ireq,req,status_array,ierr)
6928 do iii=1,ntask_cont_from
6929 iproc=itask_cont_from(iii)
6932 write (iout,*) "Received",nn," contacts from processor",iproc,
6933 & " of CONT_FROM_COMM group"
6936 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6941 ii=zapas_recv(1,i,iii)
6942 c Flag the received contacts to prevent double-counting
6943 jj=-zapas_recv(2,i,iii)
6944 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6946 nnn=num_cont_hb(ii)+1
6949 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6953 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6958 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6966 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6975 write (iout,'(a)') 'Contact function values after receive:'
6977 write (iout,'(2i3,50(1x,i3,5f6.3))')
6978 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6979 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6986 write (iout,'(a)') 'Contact function values:'
6988 write (iout,'(2i3,50(1x,i2,5f6.3))')
6989 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6990 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6996 C Remove the loop below after debugging !!!
7003 C Calculate the dipole-dipole interaction energies
7004 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7005 do i=iatel_s,iatel_e+1
7006 num_conti=num_cont_hb(i)
7015 C Calculate the local-electrostatic correlation terms
7016 c write (iout,*) "gradcorr5 in eello5 before loop"
7018 c write (iout,'(i5,3f10.5)')
7019 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7021 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7022 c write (iout,*) "corr loop i",i
7024 num_conti=num_cont_hb(i)
7025 num_conti1=num_cont_hb(i+1)
7032 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7033 c & ' jj=',jj,' kk=',kk
7034 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7035 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7036 & .or. j.lt.0 .and. j1.gt.0) .and.
7037 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7038 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7039 C The system gains extra energy.
7041 sqd1=dsqrt(d_cont(jj,i))
7042 sqd2=dsqrt(d_cont(kk,i1))
7043 sred_geom = sqd1*sqd2
7044 IF (sred_geom.lt.cutoff_corr) THEN
7045 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7047 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7048 cd & ' jj=',jj,' kk=',kk
7049 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7050 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7052 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7053 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7056 cd write (iout,*) 'sred_geom=',sred_geom,
7057 cd & ' ekont=',ekont,' fprim=',fprimcont,
7058 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7059 cd write (iout,*) "g_contij",g_contij
7060 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7061 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7062 call calc_eello(i,jp,i+1,jp1,jj,kk)
7063 if (wcorr4.gt.0.0d0)
7064 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7065 if (energy_dec.and.wcorr4.gt.0.0d0)
7066 1 write (iout,'(a6,4i5,0pf7.3)')
7067 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7068 c write (iout,*) "gradcorr5 before eello5"
7070 c write (iout,'(i5,3f10.5)')
7071 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7073 if (wcorr5.gt.0.0d0)
7074 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7075 c write (iout,*) "gradcorr5 after eello5"
7077 c write (iout,'(i5,3f10.5)')
7078 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7080 if (energy_dec.and.wcorr5.gt.0.0d0)
7081 1 write (iout,'(a6,4i5,0pf7.3)')
7082 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7083 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7084 cd write(2,*)'ijkl',i,jp,i+1,jp1
7085 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7086 & .or. wturn6.eq.0.0d0))then
7087 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7088 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7089 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7090 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7091 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7092 cd & 'ecorr6=',ecorr6
7093 cd write (iout,'(4e15.5)') sred_geom,
7094 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7095 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7096 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7097 else if (wturn6.gt.0.0d0
7098 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7099 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7100 eturn6=eturn6+eello_turn6(i,jj,kk)
7101 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7102 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7103 cd write (2,*) 'multibody_eello:eturn6',eturn6
7112 num_cont_hb(i)=num_cont_hb_old(i)
7114 c write (iout,*) "gradcorr5 in eello5"
7116 c write (iout,'(i5,3f10.5)')
7117 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7121 c------------------------------------------------------------------------------
7122 subroutine add_hb_contact_eello(ii,jj,itask)
7123 implicit real*8 (a-h,o-z)
7124 include "DIMENSIONS"
7125 include "COMMON.IOUNITS"
7128 parameter (max_cont=maxconts)
7129 parameter (max_dim=70)
7130 include "COMMON.CONTACTS"
7131 double precision zapas(max_dim,maxconts,max_fg_procs),
7132 & zapas_recv(max_dim,maxconts,max_fg_procs)
7133 common /przechowalnia/ zapas
7134 integer i,j,ii,jj,iproc,itask(4),nn
7135 c write (iout,*) "itask",itask
7138 if (iproc.gt.0) then
7139 do j=1,num_cont_hb(ii)
7141 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7143 ncont_sent(iproc)=ncont_sent(iproc)+1
7144 nn=ncont_sent(iproc)
7145 zapas(1,nn,iproc)=ii
7146 zapas(2,nn,iproc)=jjc
7147 zapas(3,nn,iproc)=d_cont(j,ii)
7151 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7156 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7164 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7176 c------------------------------------------------------------------------------
7177 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7178 implicit real*8 (a-h,o-z)
7179 include 'DIMENSIONS'
7180 include 'COMMON.IOUNITS'
7181 include 'COMMON.DERIV'
7182 include 'COMMON.INTERACT'
7183 include 'COMMON.CONTACTS'
7184 double precision gx(3),gx1(3)
7194 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7195 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7196 C Following 4 lines for diagnostics.
7201 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7202 c & 'Contacts ',i,j,
7203 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7204 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7206 C Calculate the multi-body contribution to energy.
7207 c ecorr=ecorr+ekont*ees
7208 C Calculate multi-body contributions to the gradient.
7209 coeffpees0pij=coeffp*ees0pij
7210 coeffmees0mij=coeffm*ees0mij
7211 coeffpees0pkl=coeffp*ees0pkl
7212 coeffmees0mkl=coeffm*ees0mkl
7214 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7215 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7216 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7217 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7218 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7219 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7220 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7221 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7222 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7223 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7224 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7225 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7226 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7227 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7228 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7229 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7230 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7231 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7232 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7233 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7234 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7235 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7236 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7237 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7238 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7243 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7244 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7245 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7246 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7251 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7252 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7253 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7254 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7257 c write (iout,*) "ehbcorr",ekont*ees
7262 C---------------------------------------------------------------------------
7263 subroutine dipole(i,j,jj)
7264 implicit real*8 (a-h,o-z)
7265 include 'DIMENSIONS'
7266 include 'COMMON.IOUNITS'
7267 include 'COMMON.CHAIN'
7268 include 'COMMON.FFIELD'
7269 include 'COMMON.DERIV'
7270 include 'COMMON.INTERACT'
7271 include 'COMMON.CONTACTS'
7272 include 'COMMON.TORSION'
7273 include 'COMMON.VAR'
7274 include 'COMMON.GEO'
7275 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7277 iti1 = itortyp(itype(i+1))
7278 if (j.lt.nres-1) then
7279 itj1 = itortyp(itype(j+1))
7284 dipi(iii,1)=Ub2(iii,i)
7285 dipderi(iii)=Ub2der(iii,i)
7286 dipi(iii,2)=b1(iii,iti1)
7287 dipj(iii,1)=Ub2(iii,j)
7288 dipderj(iii)=Ub2der(iii,j)
7289 dipj(iii,2)=b1(iii,itj1)
7293 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7296 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7303 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7307 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7312 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7313 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7315 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7317 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7319 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7324 C---------------------------------------------------------------------------
7325 subroutine calc_eello(i,j,k,l,jj,kk)
7327 C This subroutine computes matrices and vectors needed to calculate
7328 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7330 implicit real*8 (a-h,o-z)
7331 include 'DIMENSIONS'
7332 include 'COMMON.IOUNITS'
7333 include 'COMMON.CHAIN'
7334 include 'COMMON.DERIV'
7335 include 'COMMON.INTERACT'
7336 include 'COMMON.CONTACTS'
7337 include 'COMMON.TORSION'
7338 include 'COMMON.VAR'
7339 include 'COMMON.GEO'
7340 include 'COMMON.FFIELD'
7341 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7342 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7345 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7346 cd & ' jj=',jj,' kk=',kk
7347 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7348 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7349 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7352 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7353 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7356 call transpose2(aa1(1,1),aa1t(1,1))
7357 call transpose2(aa2(1,1),aa2t(1,1))
7360 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7361 & aa1tder(1,1,lll,kkk))
7362 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7363 & aa2tder(1,1,lll,kkk))
7367 C parallel orientation of the two CA-CA-CA frames.
7369 iti=itortyp(itype(i))
7373 itk1=itortyp(itype(k+1))
7374 itj=itortyp(itype(j))
7375 if (l.lt.nres-1) then
7376 itl1=itortyp(itype(l+1))
7380 C A1 kernel(j+1) A2T
7382 cd write (iout,'(3f10.5,5x,3f10.5)')
7383 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7385 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7386 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7387 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7388 C Following matrices are needed only for 6-th order cumulants
7389 IF (wcorr6.gt.0.0d0) THEN
7390 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7391 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7392 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7393 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7394 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7395 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7396 & ADtEAderx(1,1,1,1,1,1))
7398 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7399 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7400 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7401 & ADtEA1derx(1,1,1,1,1,1))
7403 C End 6-th order cumulants
7406 cd write (2,*) 'In calc_eello6'
7408 cd write (2,*) 'iii=',iii
7410 cd write (2,*) 'kkk=',kkk
7412 cd write (2,'(3(2f10.5),5x)')
7413 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7418 call transpose2(EUgder(1,1,k),auxmat(1,1))
7419 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7420 call transpose2(EUg(1,1,k),auxmat(1,1))
7421 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7422 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7426 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7427 & EAEAderx(1,1,lll,kkk,iii,1))
7431 C A1T kernel(i+1) A2
7432 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7433 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7434 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7435 C Following matrices are needed only for 6-th order cumulants
7436 IF (wcorr6.gt.0.0d0) THEN
7437 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7438 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7439 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7440 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7441 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7442 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7443 & ADtEAderx(1,1,1,1,1,2))
7444 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7445 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7446 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7447 & ADtEA1derx(1,1,1,1,1,2))
7449 C End 6-th order cumulants
7450 call transpose2(EUgder(1,1,l),auxmat(1,1))
7451 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7452 call transpose2(EUg(1,1,l),auxmat(1,1))
7453 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7454 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7458 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7459 & EAEAderx(1,1,lll,kkk,iii,2))
7464 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7465 C They are needed only when the fifth- or the sixth-order cumulants are
7467 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7468 call transpose2(AEA(1,1,1),auxmat(1,1))
7469 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7470 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7471 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7472 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7473 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7474 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7475 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7476 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7477 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7478 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7479 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7480 call transpose2(AEA(1,1,2),auxmat(1,1))
7481 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7482 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7483 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7484 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7485 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7486 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7487 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7488 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7489 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7490 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7491 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7492 C Calculate the Cartesian derivatives of the vectors.
7496 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7497 call matvec2(auxmat(1,1),b1(1,iti),
7498 & AEAb1derx(1,lll,kkk,iii,1,1))
7499 call matvec2(auxmat(1,1),Ub2(1,i),
7500 & AEAb2derx(1,lll,kkk,iii,1,1))
7501 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7502 & AEAb1derx(1,lll,kkk,iii,2,1))
7503 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7504 & AEAb2derx(1,lll,kkk,iii,2,1))
7505 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7506 call matvec2(auxmat(1,1),b1(1,itj),
7507 & AEAb1derx(1,lll,kkk,iii,1,2))
7508 call matvec2(auxmat(1,1),Ub2(1,j),
7509 & AEAb2derx(1,lll,kkk,iii,1,2))
7510 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7511 & AEAb1derx(1,lll,kkk,iii,2,2))
7512 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7513 & AEAb2derx(1,lll,kkk,iii,2,2))
7520 C Antiparallel orientation of the two CA-CA-CA frames.
7522 iti=itortyp(itype(i))
7526 itk1=itortyp(itype(k+1))
7527 itl=itortyp(itype(l))
7528 itj=itortyp(itype(j))
7529 if (j.lt.nres-1) then
7530 itj1=itortyp(itype(j+1))
7534 C A2 kernel(j-1)T A1T
7535 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7536 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7537 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7538 C Following matrices are needed only for 6-th order cumulants
7539 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7540 & j.eq.i+4 .and. l.eq.i+3)) THEN
7541 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7542 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7543 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7544 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7545 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7546 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7547 & ADtEAderx(1,1,1,1,1,1))
7548 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7549 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7550 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7551 & ADtEA1derx(1,1,1,1,1,1))
7553 C End 6-th order cumulants
7554 call transpose2(EUgder(1,1,k),auxmat(1,1))
7555 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7556 call transpose2(EUg(1,1,k),auxmat(1,1))
7557 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7558 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7562 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7563 & EAEAderx(1,1,lll,kkk,iii,1))
7567 C A2T kernel(i+1)T A1
7568 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7569 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7570 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7571 C Following matrices are needed only for 6-th order cumulants
7572 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7573 & j.eq.i+4 .and. l.eq.i+3)) THEN
7574 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7575 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7576 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7577 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7578 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7579 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7580 & ADtEAderx(1,1,1,1,1,2))
7581 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7582 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7583 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7584 & ADtEA1derx(1,1,1,1,1,2))
7586 C End 6-th order cumulants
7587 call transpose2(EUgder(1,1,j),auxmat(1,1))
7588 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7589 call transpose2(EUg(1,1,j),auxmat(1,1))
7590 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7591 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7595 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7596 & EAEAderx(1,1,lll,kkk,iii,2))
7601 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7602 C They are needed only when the fifth- or the sixth-order cumulants are
7604 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7605 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7606 call transpose2(AEA(1,1,1),auxmat(1,1))
7607 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7608 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7609 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7610 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7611 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7612 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7613 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7614 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7615 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7616 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7617 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7618 call transpose2(AEA(1,1,2),auxmat(1,1))
7619 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7620 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7621 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7622 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7623 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7624 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7625 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7626 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7627 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7628 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7629 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7630 C Calculate the Cartesian derivatives of the vectors.
7634 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7635 call matvec2(auxmat(1,1),b1(1,iti),
7636 & AEAb1derx(1,lll,kkk,iii,1,1))
7637 call matvec2(auxmat(1,1),Ub2(1,i),
7638 & AEAb2derx(1,lll,kkk,iii,1,1))
7639 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7640 & AEAb1derx(1,lll,kkk,iii,2,1))
7641 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7642 & AEAb2derx(1,lll,kkk,iii,2,1))
7643 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7644 call matvec2(auxmat(1,1),b1(1,itl),
7645 & AEAb1derx(1,lll,kkk,iii,1,2))
7646 call matvec2(auxmat(1,1),Ub2(1,l),
7647 & AEAb2derx(1,lll,kkk,iii,1,2))
7648 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7649 & AEAb1derx(1,lll,kkk,iii,2,2))
7650 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7651 & AEAb2derx(1,lll,kkk,iii,2,2))
7660 C---------------------------------------------------------------------------
7661 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7662 & KK,KKderg,AKA,AKAderg,AKAderx)
7666 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7667 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7668 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7673 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7675 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7678 cd if (lprn) write (2,*) 'In kernel'
7680 cd if (lprn) write (2,*) 'kkk=',kkk
7682 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7683 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7685 cd write (2,*) 'lll=',lll
7686 cd write (2,*) 'iii=1'
7688 cd write (2,'(3(2f10.5),5x)')
7689 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7692 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7693 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7695 cd write (2,*) 'lll=',lll
7696 cd write (2,*) 'iii=2'
7698 cd write (2,'(3(2f10.5),5x)')
7699 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7706 C---------------------------------------------------------------------------
7707 double precision function eello4(i,j,k,l,jj,kk)
7708 implicit real*8 (a-h,o-z)
7709 include 'DIMENSIONS'
7710 include 'COMMON.IOUNITS'
7711 include 'COMMON.CHAIN'
7712 include 'COMMON.DERIV'
7713 include 'COMMON.INTERACT'
7714 include 'COMMON.CONTACTS'
7715 include 'COMMON.TORSION'
7716 include 'COMMON.VAR'
7717 include 'COMMON.GEO'
7718 double precision pizda(2,2),ggg1(3),ggg2(3)
7719 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7723 cd print *,'eello4:',i,j,k,l,jj,kk
7724 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7725 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7726 cold eij=facont_hb(jj,i)
7727 cold ekl=facont_hb(kk,k)
7729 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7730 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7731 gcorr_loc(k-1)=gcorr_loc(k-1)
7732 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7734 gcorr_loc(l-1)=gcorr_loc(l-1)
7735 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7737 gcorr_loc(j-1)=gcorr_loc(j-1)
7738 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7743 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7744 & -EAEAderx(2,2,lll,kkk,iii,1)
7745 cd derx(lll,kkk,iii)=0.0d0
7749 cd gcorr_loc(l-1)=0.0d0
7750 cd gcorr_loc(j-1)=0.0d0
7751 cd gcorr_loc(k-1)=0.0d0
7753 cd write (iout,*)'Contacts have occurred for peptide groups',
7754 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7755 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7756 if (j.lt.nres-1) then
7763 if (l.lt.nres-1) then
7771 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7772 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7773 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7774 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7775 cgrad ghalf=0.5d0*ggg1(ll)
7776 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7777 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7778 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7779 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7780 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7781 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7782 cgrad ghalf=0.5d0*ggg2(ll)
7783 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7784 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7785 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7786 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7787 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7788 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7792 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7797 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7802 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7807 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7811 cd write (2,*) iii,gcorr_loc(iii)
7814 cd write (2,*) 'ekont',ekont
7815 cd write (iout,*) 'eello4',ekont*eel4
7818 C---------------------------------------------------------------------------
7819 double precision function eello5(i,j,k,l,jj,kk)
7820 implicit real*8 (a-h,o-z)
7821 include 'DIMENSIONS'
7822 include 'COMMON.IOUNITS'
7823 include 'COMMON.CHAIN'
7824 include 'COMMON.DERIV'
7825 include 'COMMON.INTERACT'
7826 include 'COMMON.CONTACTS'
7827 include 'COMMON.TORSION'
7828 include 'COMMON.VAR'
7829 include 'COMMON.GEO'
7830 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7831 double precision ggg1(3),ggg2(3)
7832 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7837 C /l\ / \ \ / \ / \ / C
7838 C / \ / \ \ / \ / \ / C
7839 C j| o |l1 | o | o| o | | o |o C
7840 C \ |/k\| |/ \| / |/ \| |/ \| C
7841 C \i/ \ / \ / / \ / \ C
7843 C (I) (II) (III) (IV) C
7845 C eello5_1 eello5_2 eello5_3 eello5_4 C
7847 C Antiparallel chains C
7850 C /j\ / \ \ / \ / \ / C
7851 C / \ / \ \ / \ / \ / C
7852 C j1| o |l | o | o| o | | o |o C
7853 C \ |/k\| |/ \| / |/ \| |/ \| C
7854 C \i/ \ / \ / / \ / \ C
7856 C (I) (II) (III) (IV) C
7858 C eello5_1 eello5_2 eello5_3 eello5_4 C
7860 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7862 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7863 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7868 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7870 itk=itortyp(itype(k))
7871 itl=itortyp(itype(l))
7872 itj=itortyp(itype(j))
7877 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7878 cd & eel5_3_num,eel5_4_num)
7882 derx(lll,kkk,iii)=0.0d0
7886 cd eij=facont_hb(jj,i)
7887 cd ekl=facont_hb(kk,k)
7889 cd write (iout,*)'Contacts have occurred for peptide groups',
7890 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7892 C Contribution from the graph I.
7893 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7894 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7895 call transpose2(EUg(1,1,k),auxmat(1,1))
7896 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7897 vv(1)=pizda(1,1)-pizda(2,2)
7898 vv(2)=pizda(1,2)+pizda(2,1)
7899 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7900 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7901 C Explicit gradient in virtual-dihedral angles.
7902 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7903 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7904 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7905 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7906 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7907 vv(1)=pizda(1,1)-pizda(2,2)
7908 vv(2)=pizda(1,2)+pizda(2,1)
7909 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7910 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7911 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7912 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7913 vv(1)=pizda(1,1)-pizda(2,2)
7914 vv(2)=pizda(1,2)+pizda(2,1)
7916 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7917 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7918 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7920 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7921 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7922 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7924 C Cartesian gradient
7928 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7930 vv(1)=pizda(1,1)-pizda(2,2)
7931 vv(2)=pizda(1,2)+pizda(2,1)
7932 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7933 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7934 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7940 C Contribution from graph II
7941 call transpose2(EE(1,1,itk),auxmat(1,1))
7942 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7943 vv(1)=pizda(1,1)+pizda(2,2)
7944 vv(2)=pizda(2,1)-pizda(1,2)
7945 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7946 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7947 C Explicit gradient in virtual-dihedral angles.
7948 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7949 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7950 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7951 vv(1)=pizda(1,1)+pizda(2,2)
7952 vv(2)=pizda(2,1)-pizda(1,2)
7954 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7955 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7956 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7958 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7959 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7960 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7962 C Cartesian gradient
7966 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7968 vv(1)=pizda(1,1)+pizda(2,2)
7969 vv(2)=pizda(2,1)-pizda(1,2)
7970 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7971 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7972 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7980 C Parallel orientation
7981 C Contribution from graph III
7982 call transpose2(EUg(1,1,l),auxmat(1,1))
7983 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7984 vv(1)=pizda(1,1)-pizda(2,2)
7985 vv(2)=pizda(1,2)+pizda(2,1)
7986 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7987 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7988 C Explicit gradient in virtual-dihedral angles.
7989 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7990 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7991 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7992 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7993 vv(1)=pizda(1,1)-pizda(2,2)
7994 vv(2)=pizda(1,2)+pizda(2,1)
7995 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7996 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7997 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7998 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7999 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8000 vv(1)=pizda(1,1)-pizda(2,2)
8001 vv(2)=pizda(1,2)+pizda(2,1)
8002 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8003 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8004 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8005 C Cartesian gradient
8009 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8011 vv(1)=pizda(1,1)-pizda(2,2)
8012 vv(2)=pizda(1,2)+pizda(2,1)
8013 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8014 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8015 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8020 C Contribution from graph IV
8022 call transpose2(EE(1,1,itl),auxmat(1,1))
8023 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8024 vv(1)=pizda(1,1)+pizda(2,2)
8025 vv(2)=pizda(2,1)-pizda(1,2)
8026 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
8027 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8028 C Explicit gradient in virtual-dihedral angles.
8029 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8030 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8031 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8032 vv(1)=pizda(1,1)+pizda(2,2)
8033 vv(2)=pizda(2,1)-pizda(1,2)
8034 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8035 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
8036 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8037 C Cartesian gradient
8041 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8043 vv(1)=pizda(1,1)+pizda(2,2)
8044 vv(2)=pizda(2,1)-pizda(1,2)
8045 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8046 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
8047 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8052 C Antiparallel orientation
8053 C Contribution from graph III
8055 call transpose2(EUg(1,1,j),auxmat(1,1))
8056 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8057 vv(1)=pizda(1,1)-pizda(2,2)
8058 vv(2)=pizda(1,2)+pizda(2,1)
8059 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8060 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8061 C Explicit gradient in virtual-dihedral angles.
8062 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8063 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8064 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8065 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8066 vv(1)=pizda(1,1)-pizda(2,2)
8067 vv(2)=pizda(1,2)+pizda(2,1)
8068 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8069 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8070 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8071 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8072 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8073 vv(1)=pizda(1,1)-pizda(2,2)
8074 vv(2)=pizda(1,2)+pizda(2,1)
8075 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8076 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8077 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8078 C Cartesian gradient
8082 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8084 vv(1)=pizda(1,1)-pizda(2,2)
8085 vv(2)=pizda(1,2)+pizda(2,1)
8086 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8087 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8088 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8093 C Contribution from graph IV
8095 call transpose2(EE(1,1,itj),auxmat(1,1))
8096 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8097 vv(1)=pizda(1,1)+pizda(2,2)
8098 vv(2)=pizda(2,1)-pizda(1,2)
8099 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
8100 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8101 C Explicit gradient in virtual-dihedral angles.
8102 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8103 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8104 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8105 vv(1)=pizda(1,1)+pizda(2,2)
8106 vv(2)=pizda(2,1)-pizda(1,2)
8107 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8108 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
8109 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8110 C Cartesian gradient
8114 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8116 vv(1)=pizda(1,1)+pizda(2,2)
8117 vv(2)=pizda(2,1)-pizda(1,2)
8118 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8119 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
8120 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8126 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8127 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8128 cd write (2,*) 'ijkl',i,j,k,l
8129 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8130 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8132 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8133 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8134 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8135 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8136 if (j.lt.nres-1) then
8143 if (l.lt.nres-1) then
8153 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8154 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8155 C summed up outside the subrouine as for the other subroutines
8156 C handling long-range interactions. The old code is commented out
8157 C with "cgrad" to keep track of changes.
8159 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8160 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8161 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8162 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8163 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8164 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8165 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8166 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8167 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8168 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8170 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8171 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8172 cgrad ghalf=0.5d0*ggg1(ll)
8174 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8175 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8176 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8177 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8178 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8179 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8180 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8181 cgrad ghalf=0.5d0*ggg2(ll)
8183 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8184 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8185 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8186 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8187 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8188 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8193 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8194 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8199 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8200 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8206 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8211 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8215 cd write (2,*) iii,g_corr5_loc(iii)
8218 cd write (2,*) 'ekont',ekont
8219 cd write (iout,*) 'eello5',ekont*eel5
8222 c--------------------------------------------------------------------------
8223 double precision function eello6(i,j,k,l,jj,kk)
8224 implicit real*8 (a-h,o-z)
8225 include 'DIMENSIONS'
8226 include 'COMMON.IOUNITS'
8227 include 'COMMON.CHAIN'
8228 include 'COMMON.DERIV'
8229 include 'COMMON.INTERACT'
8230 include 'COMMON.CONTACTS'
8231 include 'COMMON.TORSION'
8232 include 'COMMON.VAR'
8233 include 'COMMON.GEO'
8234 include 'COMMON.FFIELD'
8235 double precision ggg1(3),ggg2(3)
8236 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8241 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8249 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8250 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8254 derx(lll,kkk,iii)=0.0d0
8258 cd eij=facont_hb(jj,i)
8259 cd ekl=facont_hb(kk,k)
8265 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8266 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8267 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8268 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8269 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8270 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8272 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8273 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8274 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8275 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8276 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8277 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8281 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8283 C If turn contributions are considered, they will be handled separately.
8284 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8285 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8286 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8287 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8288 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8289 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8290 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8292 if (j.lt.nres-1) then
8299 if (l.lt.nres-1) then
8307 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8308 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8309 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8310 cgrad ghalf=0.5d0*ggg1(ll)
8312 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8313 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8314 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8315 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8316 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8317 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8318 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8319 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8320 cgrad ghalf=0.5d0*ggg2(ll)
8321 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8323 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8324 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8325 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8326 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8327 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8328 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8333 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8334 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8339 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8340 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8346 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8351 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8355 cd write (2,*) iii,g_corr6_loc(iii)
8358 cd write (2,*) 'ekont',ekont
8359 cd write (iout,*) 'eello6',ekont*eel6
8362 c--------------------------------------------------------------------------
8363 double precision function eello6_graph1(i,j,k,l,imat,swap)
8364 implicit real*8 (a-h,o-z)
8365 include 'DIMENSIONS'
8366 include 'COMMON.IOUNITS'
8367 include 'COMMON.CHAIN'
8368 include 'COMMON.DERIV'
8369 include 'COMMON.INTERACT'
8370 include 'COMMON.CONTACTS'
8371 include 'COMMON.TORSION'
8372 include 'COMMON.VAR'
8373 include 'COMMON.GEO'
8374 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8378 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8380 C Parallel Antiparallel C
8386 C \ j|/k\| / \ |/k\|l / C
8391 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8392 itk=itortyp(itype(k))
8393 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8394 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8395 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8396 call transpose2(EUgC(1,1,k),auxmat(1,1))
8397 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8398 vv1(1)=pizda1(1,1)-pizda1(2,2)
8399 vv1(2)=pizda1(1,2)+pizda1(2,1)
8400 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8401 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8402 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8403 s5=scalar2(vv(1),Dtobr2(1,i))
8404 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8405 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8406 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8407 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8408 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8409 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8410 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8411 & +scalar2(vv(1),Dtobr2der(1,i)))
8412 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8413 vv1(1)=pizda1(1,1)-pizda1(2,2)
8414 vv1(2)=pizda1(1,2)+pizda1(2,1)
8415 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8416 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8418 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8419 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8420 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8421 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8422 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8424 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8425 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8426 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8427 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8428 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8430 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8431 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8432 vv1(1)=pizda1(1,1)-pizda1(2,2)
8433 vv1(2)=pizda1(1,2)+pizda1(2,1)
8434 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8435 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8436 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8437 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8446 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8447 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8448 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8449 call transpose2(EUgC(1,1,k),auxmat(1,1))
8450 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8452 vv1(1)=pizda1(1,1)-pizda1(2,2)
8453 vv1(2)=pizda1(1,2)+pizda1(2,1)
8454 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8455 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8456 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8457 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8458 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8459 s5=scalar2(vv(1),Dtobr2(1,i))
8460 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8466 c----------------------------------------------------------------------------
8467 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8468 implicit real*8 (a-h,o-z)
8469 include 'DIMENSIONS'
8470 include 'COMMON.IOUNITS'
8471 include 'COMMON.CHAIN'
8472 include 'COMMON.DERIV'
8473 include 'COMMON.INTERACT'
8474 include 'COMMON.CONTACTS'
8475 include 'COMMON.TORSION'
8476 include 'COMMON.VAR'
8477 include 'COMMON.GEO'
8479 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8480 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8483 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8485 C Parallel Antiparallel C
8491 C \ j|/k\| \ |/k\|l C
8496 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8497 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8498 C AL 7/4/01 s1 would occur in the sixth-order moment,
8499 C but not in a cluster cumulant
8501 s1=dip(1,jj,i)*dip(1,kk,k)
8503 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8504 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8505 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8506 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8507 call transpose2(EUg(1,1,k),auxmat(1,1))
8508 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8509 vv(1)=pizda(1,1)-pizda(2,2)
8510 vv(2)=pizda(1,2)+pizda(2,1)
8511 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8512 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8514 eello6_graph2=-(s1+s2+s3+s4)
8516 eello6_graph2=-(s2+s3+s4)
8519 C Derivatives in gamma(i-1)
8522 s1=dipderg(1,jj,i)*dip(1,kk,k)
8524 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8525 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8526 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8527 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8529 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8531 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8533 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8535 C Derivatives in gamma(k-1)
8537 s1=dip(1,jj,i)*dipderg(1,kk,k)
8539 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8540 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8541 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8542 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8543 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8544 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8545 vv(1)=pizda(1,1)-pizda(2,2)
8546 vv(2)=pizda(1,2)+pizda(2,1)
8547 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8549 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8551 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8553 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8554 C Derivatives in gamma(j-1) or gamma(l-1)
8557 s1=dipderg(3,jj,i)*dip(1,kk,k)
8559 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8560 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8561 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8562 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8563 vv(1)=pizda(1,1)-pizda(2,2)
8564 vv(2)=pizda(1,2)+pizda(2,1)
8565 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8568 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8570 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8573 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8574 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8576 C Derivatives in gamma(l-1) or gamma(j-1)
8579 s1=dip(1,jj,i)*dipderg(3,kk,k)
8581 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8582 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8583 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8584 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8585 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8586 vv(1)=pizda(1,1)-pizda(2,2)
8587 vv(2)=pizda(1,2)+pizda(2,1)
8588 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8591 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8593 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8596 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8597 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8599 C Cartesian derivatives.
8601 write (2,*) 'In eello6_graph2'
8603 write (2,*) 'iii=',iii
8605 write (2,*) 'kkk=',kkk
8607 write (2,'(3(2f10.5),5x)')
8608 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8618 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8620 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8623 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8625 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8626 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8628 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8629 call transpose2(EUg(1,1,k),auxmat(1,1))
8630 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8632 vv(1)=pizda(1,1)-pizda(2,2)
8633 vv(2)=pizda(1,2)+pizda(2,1)
8634 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8635 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8637 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8639 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8642 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8644 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8651 c----------------------------------------------------------------------------
8652 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8653 implicit real*8 (a-h,o-z)
8654 include 'DIMENSIONS'
8655 include 'COMMON.IOUNITS'
8656 include 'COMMON.CHAIN'
8657 include 'COMMON.DERIV'
8658 include 'COMMON.INTERACT'
8659 include 'COMMON.CONTACTS'
8660 include 'COMMON.TORSION'
8661 include 'COMMON.VAR'
8662 include 'COMMON.GEO'
8663 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8665 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8667 C Parallel Antiparallel C
8673 C j|/k\| / |/k\|l / C
8678 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8680 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8681 C energy moment and not to the cluster cumulant.
8682 iti=itortyp(itype(i))
8683 if (j.lt.nres-1) then
8684 itj1=itortyp(itype(j+1))
8688 itk=itortyp(itype(k))
8689 itk1=itortyp(itype(k+1))
8690 if (l.lt.nres-1) then
8691 itl1=itortyp(itype(l+1))
8696 s1=dip(4,jj,i)*dip(4,kk,k)
8698 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8699 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8700 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8701 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8702 call transpose2(EE(1,1,itk),auxmat(1,1))
8703 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8704 vv(1)=pizda(1,1)+pizda(2,2)
8705 vv(2)=pizda(2,1)-pizda(1,2)
8706 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8707 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8708 cd & "sum",-(s2+s3+s4)
8710 eello6_graph3=-(s1+s2+s3+s4)
8712 eello6_graph3=-(s2+s3+s4)
8715 C Derivatives in gamma(k-1)
8716 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8717 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8718 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8719 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8720 C Derivatives in gamma(l-1)
8721 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8722 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8723 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8724 vv(1)=pizda(1,1)+pizda(2,2)
8725 vv(2)=pizda(2,1)-pizda(1,2)
8726 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8727 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8728 C Cartesian derivatives.
8734 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8736 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8739 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8741 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8742 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8744 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8745 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8747 vv(1)=pizda(1,1)+pizda(2,2)
8748 vv(2)=pizda(2,1)-pizda(1,2)
8749 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8751 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8753 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8756 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8758 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8760 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8766 c----------------------------------------------------------------------------
8767 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8768 implicit real*8 (a-h,o-z)
8769 include 'DIMENSIONS'
8770 include 'COMMON.IOUNITS'
8771 include 'COMMON.CHAIN'
8772 include 'COMMON.DERIV'
8773 include 'COMMON.INTERACT'
8774 include 'COMMON.CONTACTS'
8775 include 'COMMON.TORSION'
8776 include 'COMMON.VAR'
8777 include 'COMMON.GEO'
8778 include 'COMMON.FFIELD'
8779 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8780 & auxvec1(2),auxmat1(2,2)
8782 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8784 C Parallel Antiparallel C
8790 C \ j|/k\| \ |/k\|l C
8795 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8797 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8798 C energy moment and not to the cluster cumulant.
8799 cd write (2,*) 'eello_graph4: wturn6',wturn6
8800 iti=itortyp(itype(i))
8801 itj=itortyp(itype(j))
8802 if (j.lt.nres-1) then
8803 itj1=itortyp(itype(j+1))
8807 itk=itortyp(itype(k))
8808 if (k.lt.nres-1) then
8809 itk1=itortyp(itype(k+1))
8813 itl=itortyp(itype(l))
8814 if (l.lt.nres-1) then
8815 itl1=itortyp(itype(l+1))
8819 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8820 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8821 cd & ' itl',itl,' itl1',itl1
8824 s1=dip(3,jj,i)*dip(3,kk,k)
8826 s1=dip(2,jj,j)*dip(2,kk,l)
8829 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8830 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8832 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8833 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8835 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8836 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8838 call transpose2(EUg(1,1,k),auxmat(1,1))
8839 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8840 vv(1)=pizda(1,1)-pizda(2,2)
8841 vv(2)=pizda(2,1)+pizda(1,2)
8842 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8843 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8845 eello6_graph4=-(s1+s2+s3+s4)
8847 eello6_graph4=-(s2+s3+s4)
8849 C Derivatives in gamma(i-1)
8853 s1=dipderg(2,jj,i)*dip(3,kk,k)
8855 s1=dipderg(4,jj,j)*dip(2,kk,l)
8858 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8860 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8861 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8863 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8864 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8866 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8867 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8868 cd write (2,*) 'turn6 derivatives'
8870 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8872 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8876 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8878 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8882 C Derivatives in gamma(k-1)
8885 s1=dip(3,jj,i)*dipderg(2,kk,k)
8887 s1=dip(2,jj,j)*dipderg(4,kk,l)
8890 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8891 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8893 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8894 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8896 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8897 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8899 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8900 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8901 vv(1)=pizda(1,1)-pizda(2,2)
8902 vv(2)=pizda(2,1)+pizda(1,2)
8903 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8904 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8906 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8908 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8912 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8914 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8917 C Derivatives in gamma(j-1) or gamma(l-1)
8918 if (l.eq.j+1 .and. l.gt.1) then
8919 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8920 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8921 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8922 vv(1)=pizda(1,1)-pizda(2,2)
8923 vv(2)=pizda(2,1)+pizda(1,2)
8924 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8925 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8926 else if (j.gt.1) then
8927 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8928 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8929 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8930 vv(1)=pizda(1,1)-pizda(2,2)
8931 vv(2)=pizda(2,1)+pizda(1,2)
8932 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8933 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8934 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8936 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8939 C Cartesian derivatives.
8946 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8948 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8952 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8954 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8958 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8960 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8962 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8963 & b1(1,itj1),auxvec(1))
8964 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8966 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8967 & b1(1,itl1),auxvec(1))
8968 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8970 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8972 vv(1)=pizda(1,1)-pizda(2,2)
8973 vv(2)=pizda(2,1)+pizda(1,2)
8974 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8976 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8978 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8981 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8984 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8987 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8989 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8991 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8995 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8997 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9000 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9002 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9010 c----------------------------------------------------------------------------
9011 double precision function eello_turn6(i,jj,kk)
9012 implicit real*8 (a-h,o-z)
9013 include 'DIMENSIONS'
9014 include 'COMMON.IOUNITS'
9015 include 'COMMON.CHAIN'
9016 include 'COMMON.DERIV'
9017 include 'COMMON.INTERACT'
9018 include 'COMMON.CONTACTS'
9019 include 'COMMON.TORSION'
9020 include 'COMMON.VAR'
9021 include 'COMMON.GEO'
9022 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9023 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9025 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9026 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9027 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9028 C the respective energy moment and not to the cluster cumulant.
9037 iti=itortyp(itype(i))
9038 itk=itortyp(itype(k))
9039 itk1=itortyp(itype(k+1))
9040 itl=itortyp(itype(l))
9041 itj=itortyp(itype(j))
9042 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9043 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9044 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9049 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9051 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9055 derx_turn(lll,kkk,iii)=0.0d0
9062 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9064 cd write (2,*) 'eello6_5',eello6_5
9066 call transpose2(AEA(1,1,1),auxmat(1,1))
9067 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9068 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9069 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9071 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9072 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9073 s2 = scalar2(b1(1,itk),vtemp1(1))
9075 call transpose2(AEA(1,1,2),atemp(1,1))
9076 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9077 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9078 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9080 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9081 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9082 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9084 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9085 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9086 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9087 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9088 ss13 = scalar2(b1(1,itk),vtemp4(1))
9089 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9091 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9097 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9098 C Derivatives in gamma(i+2)
9102 call transpose2(AEA(1,1,1),auxmatd(1,1))
9103 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9104 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9105 call transpose2(AEAderg(1,1,2),atempd(1,1))
9106 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9107 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9109 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9110 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9111 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9117 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9118 C Derivatives in gamma(i+3)
9120 call transpose2(AEA(1,1,1),auxmatd(1,1))
9121 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9122 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9123 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9125 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9126 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9127 s2d = scalar2(b1(1,itk),vtemp1d(1))
9129 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9130 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9132 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9134 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9135 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9136 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9144 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9145 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9147 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9148 & -0.5d0*ekont*(s2d+s12d)
9150 C Derivatives in gamma(i+4)
9151 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9152 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9153 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9155 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9156 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9157 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9165 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9167 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9169 C Derivatives in gamma(i+5)
9171 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9172 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9173 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9175 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9176 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9177 s2d = scalar2(b1(1,itk),vtemp1d(1))
9179 call transpose2(AEA(1,1,2),atempd(1,1))
9180 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9181 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9183 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9184 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9186 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9187 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9188 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9196 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9197 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9199 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9200 & -0.5d0*ekont*(s2d+s12d)
9202 C Cartesian derivatives
9207 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9208 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9209 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9211 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9212 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9214 s2d = scalar2(b1(1,itk),vtemp1d(1))
9216 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9217 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9218 s8d = -(atempd(1,1)+atempd(2,2))*
9219 & scalar2(cc(1,1,itl),vtemp2(1))
9221 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9223 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9224 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9231 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9234 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9238 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9239 & - 0.5d0*(s8d+s12d)
9241 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9250 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9252 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9253 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9254 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9255 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9256 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9258 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9259 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9260 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9264 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9265 cd & 16*eel_turn6_num
9267 if (j.lt.nres-1) then
9274 if (l.lt.nres-1) then
9282 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9283 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9284 cgrad ghalf=0.5d0*ggg1(ll)
9286 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9287 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9288 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9289 & +ekont*derx_turn(ll,2,1)
9290 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9291 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9292 & +ekont*derx_turn(ll,4,1)
9293 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9294 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9295 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9296 cgrad ghalf=0.5d0*ggg2(ll)
9298 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9299 & +ekont*derx_turn(ll,2,2)
9300 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9301 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9302 & +ekont*derx_turn(ll,4,2)
9303 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9304 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9305 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9310 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9315 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9321 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9326 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9330 cd write (2,*) iii,g_corr6_loc(iii)
9332 eello_turn6=ekont*eel_turn6
9333 cd write (2,*) 'ekont',ekont
9334 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9338 C-----------------------------------------------------------------------------
9339 double precision function scalar(u,v)
9340 !DIR$ INLINEALWAYS scalar
9342 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9345 double precision u(3),v(3)
9346 cd double precision sc
9354 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9357 crc-------------------------------------------------
9358 SUBROUTINE MATVEC2(A1,V1,V2)
9359 !DIR$ INLINEALWAYS MATVEC2
9361 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9363 implicit real*8 (a-h,o-z)
9364 include 'DIMENSIONS'
9365 DIMENSION A1(2,2),V1(2),V2(2)
9369 c 3 VI=VI+A1(I,K)*V1(K)
9373 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9374 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9379 C---------------------------------------
9380 SUBROUTINE MATMAT2(A1,A2,A3)
9382 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9384 implicit real*8 (a-h,o-z)
9385 include 'DIMENSIONS'
9386 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9387 c DIMENSION AI3(2,2)
9391 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9397 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9398 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9399 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9400 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9408 c-------------------------------------------------------------------------
9409 double precision function scalar2(u,v)
9410 !DIR$ INLINEALWAYS scalar2
9412 double precision u(2),v(2)
9415 scalar2=u(1)*v(1)+u(2)*v(2)
9419 C-----------------------------------------------------------------------------
9421 subroutine transpose2(a,at)
9422 !DIR$ INLINEALWAYS transpose2
9424 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9427 double precision a(2,2),at(2,2)
9434 c--------------------------------------------------------------------------
9435 subroutine transpose(n,a,at)
9438 double precision a(n,n),at(n,n)
9446 C---------------------------------------------------------------------------
9447 subroutine prodmat3(a1,a2,kk,transp,prod)
9448 !DIR$ INLINEALWAYS prodmat3
9450 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9454 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9456 crc double precision auxmat(2,2),prod_(2,2)
9459 crc call transpose2(kk(1,1),auxmat(1,1))
9460 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9461 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9463 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9464 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9465 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9466 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9467 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9468 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9469 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9470 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9473 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9474 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9476 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9477 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9478 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9479 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9480 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9481 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9482 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9483 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9486 c call transpose2(a2(1,1),a2t(1,1))
9489 crc print *,((prod_(i,j),i=1,2),j=1,2)
9490 crc print *,((prod(i,j),i=1,2),j=1,2)