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 if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1441 if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1442 C Condition for being inside the proper box
1443 if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1444 & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1448 if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1449 if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1450 C Condition for being inside the proper box
1451 if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1452 & (yi.lt.((yshift-0.5d0)*boxysize))) then
1456 if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1457 if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1458 C Condition for being inside the proper box
1459 if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1460 & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1464 dxi=dc_norm(1,nres+i)
1465 dyi=dc_norm(2,nres+i)
1466 dzi=dc_norm(3,nres+i)
1467 c dsci_inv=dsc_inv(itypi)
1468 dsci_inv=vbld_inv(i+nres)
1469 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1470 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1472 C Calculate SC interaction energy.
1474 do iint=1,nint_gr(i)
1475 do j=istart(i,iint),iend(i,iint)
1477 itypj=iabs(itype(j))
1478 if (itypj.eq.ntyp1) cycle
1479 c dscj_inv=dsc_inv(itypj)
1480 dscj_inv=vbld_inv(j+nres)
1481 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1482 c & 1.0d0/vbld(j+nres)
1483 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1484 sig0ij=sigma(itypi,itypj)
1485 chi1=chi(itypi,itypj)
1486 chi2=chi(itypj,itypi)
1493 alf12=0.5D0*(alf1+alf2)
1494 C For diagnostics only!!!
1507 C Return atom J into box the original box
1509 if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1510 if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1511 C Condition for being inside the proper box
1512 if ((xj.gt.((0.5d0)*boxxsize)).or.
1513 & (xj.lt.((-0.5d0)*boxxsize))) then
1517 if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1518 if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1519 C Condition for being inside the proper box
1520 if ((yj.gt.((0.5d0)*boxysize)).or.
1521 & (yj.lt.((-0.5d0)*boxysize))) then
1525 if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1526 if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1527 C Condition for being inside the proper box
1528 if ((zj.gt.((0.5d0)*boxzsize)).or.
1529 & (zj.lt.((-0.5d0)*boxzsize))) then
1533 dxj=dc_norm(1,nres+j)
1534 dyj=dc_norm(2,nres+j)
1535 dzj=dc_norm(3,nres+j)
1539 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1540 c write (iout,*) "j",j," dc_norm",
1541 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1542 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1544 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1545 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1547 c write (iout,'(a7,4f8.3)')
1548 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1549 if (sss.gt.0.0d0) then
1550 C Calculate angle-dependent terms of energy and contributions to their
1554 sig=sig0ij*dsqrt(sigsq)
1555 rij_shift=1.0D0/rij-sig+sig0ij
1556 c for diagnostics; uncomment
1557 c rij_shift=1.2*sig0ij
1558 C I hate to put IF's in the loops, but here don't have another choice!!!!
1559 if (rij_shift.le.0.0D0) then
1561 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1562 cd & restyp(itypi),i,restyp(itypj),j,
1563 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1567 c---------------------------------------------------------------
1568 rij_shift=1.0D0/rij_shift
1569 fac=rij_shift**expon
1570 e1=fac*fac*aa(itypi,itypj)
1571 e2=fac*bb(itypi,itypj)
1572 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1573 eps2der=evdwij*eps3rt
1574 eps3der=evdwij*eps2rt
1575 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1576 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1577 evdwij=evdwij*eps2rt*eps3rt
1578 evdw=evdw+evdwij*sss
1580 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1581 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1582 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1583 & restyp(itypi),i,restyp(itypj),j,
1584 & epsi,sigm,chi1,chi2,chip1,chip2,
1585 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1586 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1590 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1593 C Calculate gradient components.
1594 e1=e1*eps1*eps2rt**2*eps3rt**2
1595 fac=-expon*(e1+evdwij)*rij_shift
1598 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1599 c & evdwij,fac,sigma(itypi,itypj),expon
1600 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1602 C Calculate the radial part of the gradient
1606 C Calculate angular part of the gradient.
1615 c write (iout,*) "Number of loop steps in EGB:",ind
1616 cccc energy_dec=.false.
1619 C-----------------------------------------------------------------------------
1620 subroutine egbv(evdw)
1622 C This subroutine calculates the interaction energy of nonbonded side chains
1623 C assuming the Gay-Berne-Vorobjev potential of interaction.
1625 implicit real*8 (a-h,o-z)
1626 include 'DIMENSIONS'
1627 include 'COMMON.GEO'
1628 include 'COMMON.VAR'
1629 include 'COMMON.LOCAL'
1630 include 'COMMON.CHAIN'
1631 include 'COMMON.DERIV'
1632 include 'COMMON.NAMES'
1633 include 'COMMON.INTERACT'
1634 include 'COMMON.IOUNITS'
1635 include 'COMMON.CALC'
1636 common /srutu/ icall
1639 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1642 c if (icall.eq.0) lprn=.true.
1644 do i=iatsc_s,iatsc_e
1645 itypi=iabs(itype(i))
1646 if (itypi.eq.ntyp1) cycle
1647 itypi1=iabs(itype(i+1))
1651 dxi=dc_norm(1,nres+i)
1652 dyi=dc_norm(2,nres+i)
1653 dzi=dc_norm(3,nres+i)
1654 c dsci_inv=dsc_inv(itypi)
1655 dsci_inv=vbld_inv(i+nres)
1657 C Calculate SC interaction energy.
1659 do iint=1,nint_gr(i)
1660 do j=istart(i,iint),iend(i,iint)
1662 itypj=iabs(itype(j))
1663 if (itypj.eq.ntyp1) cycle
1664 c dscj_inv=dsc_inv(itypj)
1665 dscj_inv=vbld_inv(j+nres)
1666 sig0ij=sigma(itypi,itypj)
1667 r0ij=r0(itypi,itypj)
1668 chi1=chi(itypi,itypj)
1669 chi2=chi(itypj,itypi)
1676 alf12=0.5D0*(alf1+alf2)
1677 C For diagnostics only!!!
1690 dxj=dc_norm(1,nres+j)
1691 dyj=dc_norm(2,nres+j)
1692 dzj=dc_norm(3,nres+j)
1693 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1695 C Calculate angle-dependent terms of energy and contributions to their
1699 sig=sig0ij*dsqrt(sigsq)
1700 rij_shift=1.0D0/rij-sig+r0ij
1701 C I hate to put IF's in the loops, but here don't have another choice!!!!
1702 if (rij_shift.le.0.0D0) then
1707 c---------------------------------------------------------------
1708 rij_shift=1.0D0/rij_shift
1709 fac=rij_shift**expon
1710 e1=fac*fac*aa(itypi,itypj)
1711 e2=fac*bb(itypi,itypj)
1712 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1713 eps2der=evdwij*eps3rt
1714 eps3der=evdwij*eps2rt
1715 fac_augm=rrij**expon
1716 e_augm=augm(itypi,itypj)*fac_augm
1717 evdwij=evdwij*eps2rt*eps3rt
1718 evdw=evdw+evdwij+e_augm
1720 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1721 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1722 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1723 & restyp(itypi),i,restyp(itypj),j,
1724 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1725 & chi1,chi2,chip1,chip2,
1726 & eps1,eps2rt**2,eps3rt**2,
1727 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1730 C Calculate gradient components.
1731 e1=e1*eps1*eps2rt**2*eps3rt**2
1732 fac=-expon*(e1+evdwij)*rij_shift
1734 fac=rij*fac-2*expon*rrij*e_augm
1735 C Calculate the radial part of the gradient
1739 C Calculate angular part of the gradient.
1745 C-----------------------------------------------------------------------------
1746 subroutine sc_angular
1747 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1748 C om12. Called by ebp, egb, and egbv.
1750 include 'COMMON.CALC'
1751 include 'COMMON.IOUNITS'
1755 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1756 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1757 om12=dxi*dxj+dyi*dyj+dzi*dzj
1759 C Calculate eps1(om12) and its derivative in om12
1760 faceps1=1.0D0-om12*chiom12
1761 faceps1_inv=1.0D0/faceps1
1762 eps1=dsqrt(faceps1_inv)
1763 C Following variable is eps1*deps1/dom12
1764 eps1_om12=faceps1_inv*chiom12
1769 c write (iout,*) "om12",om12," eps1",eps1
1770 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1775 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1776 sigsq=1.0D0-facsig*faceps1_inv
1777 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1778 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1779 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1785 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1786 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1788 C Calculate eps2 and its derivatives in om1, om2, and om12.
1791 chipom12=chip12*om12
1792 facp=1.0D0-om12*chipom12
1794 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1795 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1796 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1797 C Following variable is the square root of eps2
1798 eps2rt=1.0D0-facp1*facp_inv
1799 C Following three variables are the derivatives of the square root of eps
1800 C in om1, om2, and om12.
1801 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1802 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1803 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1804 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1805 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1806 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1807 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1808 c & " eps2rt_om12",eps2rt_om12
1809 C Calculate whole angle-dependent part of epsilon and contributions
1810 C to its derivatives
1813 C----------------------------------------------------------------------------
1815 implicit real*8 (a-h,o-z)
1816 include 'DIMENSIONS'
1817 include 'COMMON.CHAIN'
1818 include 'COMMON.DERIV'
1819 include 'COMMON.CALC'
1820 include 'COMMON.IOUNITS'
1821 double precision dcosom1(3),dcosom2(3)
1822 cc print *,'sss=',sss
1823 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1824 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1825 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1826 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1830 c eom12=evdwij*eps1_om12
1832 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1833 c & " sigder",sigder
1834 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1835 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1837 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1838 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1841 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
1843 c write (iout,*) "gg",(gg(k),k=1,3)
1845 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1846 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1847 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
1848 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1849 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1850 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
1851 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1852 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1853 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1854 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1857 C Calculate the components of the gradient in DC and X
1861 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1865 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1866 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1870 C-----------------------------------------------------------------------
1871 subroutine e_softsphere(evdw)
1873 C This subroutine calculates the interaction energy of nonbonded side chains
1874 C assuming the LJ potential of interaction.
1876 implicit real*8 (a-h,o-z)
1877 include 'DIMENSIONS'
1878 parameter (accur=1.0d-10)
1879 include 'COMMON.GEO'
1880 include 'COMMON.VAR'
1881 include 'COMMON.LOCAL'
1882 include 'COMMON.CHAIN'
1883 include 'COMMON.DERIV'
1884 include 'COMMON.INTERACT'
1885 include 'COMMON.TORSION'
1886 include 'COMMON.SBRIDGE'
1887 include 'COMMON.NAMES'
1888 include 'COMMON.IOUNITS'
1889 include 'COMMON.CONTACTS'
1891 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1893 do i=iatsc_s,iatsc_e
1894 itypi=iabs(itype(i))
1895 if (itypi.eq.ntyp1) cycle
1896 itypi1=iabs(itype(i+1))
1901 C Calculate SC interaction energy.
1903 do iint=1,nint_gr(i)
1904 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1905 cd & 'iend=',iend(i,iint)
1906 do j=istart(i,iint),iend(i,iint)
1907 itypj=iabs(itype(j))
1908 if (itypj.eq.ntyp1) cycle
1912 rij=xj*xj+yj*yj+zj*zj
1913 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1914 r0ij=r0(itypi,itypj)
1916 c print *,i,j,r0ij,dsqrt(rij)
1917 if (rij.lt.r0ijsq) then
1918 evdwij=0.25d0*(rij-r0ijsq)**2
1926 C Calculate the components of the gradient in DC and X
1932 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1933 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1934 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1935 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1939 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1947 C--------------------------------------------------------------------------
1948 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1951 C Soft-sphere potential of p-p interaction
1953 implicit real*8 (a-h,o-z)
1954 include 'DIMENSIONS'
1955 include 'COMMON.CONTROL'
1956 include 'COMMON.IOUNITS'
1957 include 'COMMON.GEO'
1958 include 'COMMON.VAR'
1959 include 'COMMON.LOCAL'
1960 include 'COMMON.CHAIN'
1961 include 'COMMON.DERIV'
1962 include 'COMMON.INTERACT'
1963 include 'COMMON.CONTACTS'
1964 include 'COMMON.TORSION'
1965 include 'COMMON.VECTORS'
1966 include 'COMMON.FFIELD'
1968 cd write(iout,*) 'In EELEC_soft_sphere'
1975 do i=iatel_s,iatel_e
1976 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1980 xmedi=c(1,i)+0.5d0*dxi
1981 ymedi=c(2,i)+0.5d0*dyi
1982 zmedi=c(3,i)+0.5d0*dzi
1984 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1985 do j=ielstart(i),ielend(i)
1986 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1990 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1991 r0ij=rpp(iteli,itelj)
1996 xj=c(1,j)+0.5D0*dxj-xmedi
1997 yj=c(2,j)+0.5D0*dyj-ymedi
1998 zj=c(3,j)+0.5D0*dzj-zmedi
1999 rij=xj*xj+yj*yj+zj*zj
2000 if (rij.lt.r0ijsq) then
2001 evdw1ij=0.25d0*(rij-r0ijsq)**2
2009 C Calculate contributions to the Cartesian gradient.
2015 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2016 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2019 * Loop over residues i+1 thru j-1.
2023 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2028 cgrad do i=nnt,nct-1
2030 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2032 cgrad do j=i+1,nct-1
2034 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2040 c------------------------------------------------------------------------------
2041 subroutine vec_and_deriv
2042 implicit real*8 (a-h,o-z)
2043 include 'DIMENSIONS'
2047 include 'COMMON.IOUNITS'
2048 include 'COMMON.GEO'
2049 include 'COMMON.VAR'
2050 include 'COMMON.LOCAL'
2051 include 'COMMON.CHAIN'
2052 include 'COMMON.VECTORS'
2053 include 'COMMON.SETUP'
2054 include 'COMMON.TIME1'
2055 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2056 C Compute the local reference systems. For reference system (i), the
2057 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2058 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2060 do i=ivec_start,ivec_end
2064 if (i.eq.nres-1) then
2065 C Case of the last full residue
2066 C Compute the Z-axis
2067 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2068 costh=dcos(pi-theta(nres))
2069 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2073 C Compute the derivatives of uz
2075 uzder(2,1,1)=-dc_norm(3,i-1)
2076 uzder(3,1,1)= dc_norm(2,i-1)
2077 uzder(1,2,1)= dc_norm(3,i-1)
2079 uzder(3,2,1)=-dc_norm(1,i-1)
2080 uzder(1,3,1)=-dc_norm(2,i-1)
2081 uzder(2,3,1)= dc_norm(1,i-1)
2084 uzder(2,1,2)= dc_norm(3,i)
2085 uzder(3,1,2)=-dc_norm(2,i)
2086 uzder(1,2,2)=-dc_norm(3,i)
2088 uzder(3,2,2)= dc_norm(1,i)
2089 uzder(1,3,2)= dc_norm(2,i)
2090 uzder(2,3,2)=-dc_norm(1,i)
2092 C Compute the Y-axis
2095 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2097 C Compute the derivatives of uy
2100 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2101 & -dc_norm(k,i)*dc_norm(j,i-1)
2102 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2104 uyder(j,j,1)=uyder(j,j,1)-costh
2105 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2110 uygrad(l,k,j,i)=uyder(l,k,j)
2111 uzgrad(l,k,j,i)=uzder(l,k,j)
2115 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2116 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2117 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2118 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2121 C Compute the Z-axis
2122 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2123 costh=dcos(pi-theta(i+2))
2124 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2128 C Compute the derivatives of uz
2130 uzder(2,1,1)=-dc_norm(3,i+1)
2131 uzder(3,1,1)= dc_norm(2,i+1)
2132 uzder(1,2,1)= dc_norm(3,i+1)
2134 uzder(3,2,1)=-dc_norm(1,i+1)
2135 uzder(1,3,1)=-dc_norm(2,i+1)
2136 uzder(2,3,1)= dc_norm(1,i+1)
2139 uzder(2,1,2)= dc_norm(3,i)
2140 uzder(3,1,2)=-dc_norm(2,i)
2141 uzder(1,2,2)=-dc_norm(3,i)
2143 uzder(3,2,2)= dc_norm(1,i)
2144 uzder(1,3,2)= dc_norm(2,i)
2145 uzder(2,3,2)=-dc_norm(1,i)
2147 C Compute the Y-axis
2150 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2152 C Compute the derivatives of uy
2155 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2156 & -dc_norm(k,i)*dc_norm(j,i+1)
2157 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2159 uyder(j,j,1)=uyder(j,j,1)-costh
2160 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2165 uygrad(l,k,j,i)=uyder(l,k,j)
2166 uzgrad(l,k,j,i)=uzder(l,k,j)
2170 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2171 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2172 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2173 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2177 vbld_inv_temp(1)=vbld_inv(i+1)
2178 if (i.lt.nres-1) then
2179 vbld_inv_temp(2)=vbld_inv(i+2)
2181 vbld_inv_temp(2)=vbld_inv(i)
2186 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2187 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2192 #if defined(PARVEC) && defined(MPI)
2193 if (nfgtasks1.gt.1) then
2195 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2196 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2197 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2198 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2199 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2201 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2202 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2204 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2205 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2206 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2207 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2208 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2209 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2210 time_gather=time_gather+MPI_Wtime()-time00
2212 c if (fg_rank.eq.0) then
2213 c write (iout,*) "Arrays UY and UZ"
2215 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2222 C-----------------------------------------------------------------------------
2223 subroutine check_vecgrad
2224 implicit real*8 (a-h,o-z)
2225 include 'DIMENSIONS'
2226 include 'COMMON.IOUNITS'
2227 include 'COMMON.GEO'
2228 include 'COMMON.VAR'
2229 include 'COMMON.LOCAL'
2230 include 'COMMON.CHAIN'
2231 include 'COMMON.VECTORS'
2232 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2233 dimension uyt(3,maxres),uzt(3,maxres)
2234 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2235 double precision delta /1.0d-7/
2238 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2239 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2240 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2241 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2242 cd & (dc_norm(if90,i),if90=1,3)
2243 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2244 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2245 cd write(iout,'(a)')
2251 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2252 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2265 cd write (iout,*) 'i=',i
2267 erij(k)=dc_norm(k,i)
2271 dc_norm(k,i)=erij(k)
2273 dc_norm(j,i)=dc_norm(j,i)+delta
2274 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2276 c dc_norm(k,i)=dc_norm(k,i)/fac
2278 c write (iout,*) (dc_norm(k,i),k=1,3)
2279 c write (iout,*) (erij(k),k=1,3)
2282 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2283 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2284 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2285 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2287 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2288 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2289 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2292 dc_norm(k,i)=erij(k)
2295 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2296 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2297 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2298 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2299 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2300 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2301 cd write (iout,'(a)')
2306 C--------------------------------------------------------------------------
2307 subroutine set_matrices
2308 implicit real*8 (a-h,o-z)
2309 include 'DIMENSIONS'
2312 include "COMMON.SETUP"
2314 integer status(MPI_STATUS_SIZE)
2316 include 'COMMON.IOUNITS'
2317 include 'COMMON.GEO'
2318 include 'COMMON.VAR'
2319 include 'COMMON.LOCAL'
2320 include 'COMMON.CHAIN'
2321 include 'COMMON.DERIV'
2322 include 'COMMON.INTERACT'
2323 include 'COMMON.CONTACTS'
2324 include 'COMMON.TORSION'
2325 include 'COMMON.VECTORS'
2326 include 'COMMON.FFIELD'
2327 double precision auxvec(2),auxmat(2,2)
2329 C Compute the virtual-bond-torsional-angle dependent quantities needed
2330 C to calculate the el-loc multibody terms of various order.
2333 do i=ivec_start+2,ivec_end+2
2337 if (i .lt. nres+1) then
2374 if (i .gt. 3 .and. i .lt. nres+1) then
2375 obrot_der(1,i-2)=-sin1
2376 obrot_der(2,i-2)= cos1
2377 Ugder(1,1,i-2)= sin1
2378 Ugder(1,2,i-2)=-cos1
2379 Ugder(2,1,i-2)=-cos1
2380 Ugder(2,2,i-2)=-sin1
2383 obrot2_der(1,i-2)=-dwasin2
2384 obrot2_der(2,i-2)= dwacos2
2385 Ug2der(1,1,i-2)= dwasin2
2386 Ug2der(1,2,i-2)=-dwacos2
2387 Ug2der(2,1,i-2)=-dwacos2
2388 Ug2der(2,2,i-2)=-dwasin2
2390 obrot_der(1,i-2)=0.0d0
2391 obrot_der(2,i-2)=0.0d0
2392 Ugder(1,1,i-2)=0.0d0
2393 Ugder(1,2,i-2)=0.0d0
2394 Ugder(2,1,i-2)=0.0d0
2395 Ugder(2,2,i-2)=0.0d0
2396 obrot2_der(1,i-2)=0.0d0
2397 obrot2_der(2,i-2)=0.0d0
2398 Ug2der(1,1,i-2)=0.0d0
2399 Ug2der(1,2,i-2)=0.0d0
2400 Ug2der(2,1,i-2)=0.0d0
2401 Ug2der(2,2,i-2)=0.0d0
2403 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2404 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2405 iti = itortyp(itype(i-2))
2409 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2410 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2411 iti1 = itortyp(itype(i-1))
2415 cd write (iout,*) '*******i',i,' iti1',iti
2416 cd write (iout,*) 'b1',b1(:,iti)
2417 cd write (iout,*) 'b2',b2(:,iti)
2418 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2419 c if (i .gt. iatel_s+2) then
2420 if (i .gt. nnt+2) then
2421 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2422 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2423 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2425 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2426 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2427 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2428 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2429 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2440 DtUg2(l,k,i-2)=0.0d0
2444 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2445 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2447 muder(k,i-2)=Ub2der(k,i-2)
2449 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2450 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2451 if (itype(i-1).le.ntyp) then
2452 iti1 = itortyp(itype(i-1))
2460 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2462 cd write (iout,*) 'mu ',mu(:,i-2)
2463 cd write (iout,*) 'mu1',mu1(:,i-2)
2464 cd write (iout,*) 'mu2',mu2(:,i-2)
2465 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2467 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2468 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2469 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2470 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2471 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2472 C Vectors and matrices dependent on a single virtual-bond dihedral.
2473 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2474 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2475 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2476 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2477 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2478 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2479 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2480 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2481 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2484 C Matrices dependent on two consecutive virtual-bond dihedrals.
2485 C The order of matrices is from left to right.
2486 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2488 c do i=max0(ivec_start,2),ivec_end
2490 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2491 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2492 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2493 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2494 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2495 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2496 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2497 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2500 #if defined(MPI) && defined(PARMAT)
2502 c if (fg_rank.eq.0) then
2503 write (iout,*) "Arrays UG and UGDER before GATHER"
2505 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2506 & ((ug(l,k,i),l=1,2),k=1,2),
2507 & ((ugder(l,k,i),l=1,2),k=1,2)
2509 write (iout,*) "Arrays UG2 and UG2DER"
2511 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2512 & ((ug2(l,k,i),l=1,2),k=1,2),
2513 & ((ug2der(l,k,i),l=1,2),k=1,2)
2515 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2517 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2518 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2519 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2521 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2523 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2524 & costab(i),sintab(i),costab2(i),sintab2(i)
2526 write (iout,*) "Array MUDER"
2528 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2532 if (nfgtasks.gt.1) then
2534 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2535 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2536 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2538 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2539 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2541 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2542 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2544 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2545 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2547 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2548 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2550 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2551 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2553 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2554 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2556 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2557 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2558 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2559 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2560 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2561 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2562 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2563 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2564 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2565 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2566 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2567 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2568 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2570 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2571 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2573 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2574 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2576 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2577 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2579 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2580 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2582 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2583 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2585 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2586 & ivec_count(fg_rank1),
2587 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2589 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2590 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2592 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2593 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2595 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2596 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2598 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2599 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2601 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2602 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2604 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2605 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2607 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2608 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2610 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2611 & ivec_count(fg_rank1),
2612 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2614 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2615 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2617 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2618 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2620 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2621 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2623 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2624 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2626 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2627 & ivec_count(fg_rank1),
2628 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2630 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2631 & ivec_count(fg_rank1),
2632 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2634 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2635 & ivec_count(fg_rank1),
2636 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2637 & MPI_MAT2,FG_COMM1,IERR)
2638 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2639 & ivec_count(fg_rank1),
2640 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2641 & MPI_MAT2,FG_COMM1,IERR)
2644 c Passes matrix info through the ring
2647 if (irecv.lt.0) irecv=nfgtasks1-1
2650 if (inext.ge.nfgtasks1) inext=0
2652 c write (iout,*) "isend",isend," irecv",irecv
2654 lensend=lentyp(isend)
2655 lenrecv=lentyp(irecv)
2656 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2657 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2658 c & MPI_ROTAT1(lensend),inext,2200+isend,
2659 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2660 c & iprev,2200+irecv,FG_COMM,status,IERR)
2661 c write (iout,*) "Gather ROTAT1"
2663 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2664 c & MPI_ROTAT2(lensend),inext,3300+isend,
2665 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2666 c & iprev,3300+irecv,FG_COMM,status,IERR)
2667 c write (iout,*) "Gather ROTAT2"
2669 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2670 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2671 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2672 & iprev,4400+irecv,FG_COMM,status,IERR)
2673 c write (iout,*) "Gather ROTAT_OLD"
2675 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2676 & MPI_PRECOMP11(lensend),inext,5500+isend,
2677 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2678 & iprev,5500+irecv,FG_COMM,status,IERR)
2679 c write (iout,*) "Gather PRECOMP11"
2681 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2682 & MPI_PRECOMP12(lensend),inext,6600+isend,
2683 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2684 & iprev,6600+irecv,FG_COMM,status,IERR)
2685 c write (iout,*) "Gather PRECOMP12"
2687 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2689 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2690 & MPI_ROTAT2(lensend),inext,7700+isend,
2691 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2692 & iprev,7700+irecv,FG_COMM,status,IERR)
2693 c write (iout,*) "Gather PRECOMP21"
2695 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2696 & MPI_PRECOMP22(lensend),inext,8800+isend,
2697 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2698 & iprev,8800+irecv,FG_COMM,status,IERR)
2699 c write (iout,*) "Gather PRECOMP22"
2701 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2702 & MPI_PRECOMP23(lensend),inext,9900+isend,
2703 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2704 & MPI_PRECOMP23(lenrecv),
2705 & iprev,9900+irecv,FG_COMM,status,IERR)
2706 c write (iout,*) "Gather PRECOMP23"
2711 if (irecv.lt.0) irecv=nfgtasks1-1
2714 time_gather=time_gather+MPI_Wtime()-time00
2717 c if (fg_rank.eq.0) then
2718 write (iout,*) "Arrays UG and UGDER"
2720 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2721 & ((ug(l,k,i),l=1,2),k=1,2),
2722 & ((ugder(l,k,i),l=1,2),k=1,2)
2724 write (iout,*) "Arrays UG2 and UG2DER"
2726 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2727 & ((ug2(l,k,i),l=1,2),k=1,2),
2728 & ((ug2der(l,k,i),l=1,2),k=1,2)
2730 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2732 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2733 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2734 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2736 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2738 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2739 & costab(i),sintab(i),costab2(i),sintab2(i)
2741 write (iout,*) "Array MUDER"
2743 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2749 cd iti = itortyp(itype(i))
2752 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2753 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2758 C--------------------------------------------------------------------------
2759 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2761 C This subroutine calculates the average interaction energy and its gradient
2762 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2763 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2764 C The potential depends both on the distance of peptide-group centers and on
2765 C the orientation of the CA-CA virtual bonds.
2767 implicit real*8 (a-h,o-z)
2771 include 'DIMENSIONS'
2772 include 'COMMON.CONTROL'
2773 include 'COMMON.SETUP'
2774 include 'COMMON.IOUNITS'
2775 include 'COMMON.GEO'
2776 include 'COMMON.VAR'
2777 include 'COMMON.LOCAL'
2778 include 'COMMON.CHAIN'
2779 include 'COMMON.DERIV'
2780 include 'COMMON.INTERACT'
2781 include 'COMMON.CONTACTS'
2782 include 'COMMON.TORSION'
2783 include 'COMMON.VECTORS'
2784 include 'COMMON.FFIELD'
2785 include 'COMMON.TIME1'
2786 include 'COMMON.SPLITELE'
2787 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2788 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2789 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2790 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2791 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2792 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2794 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2796 double precision scal_el /1.0d0/
2798 double precision scal_el /0.5d0/
2801 C 13-go grudnia roku pamietnego...
2802 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2803 & 0.0d0,1.0d0,0.0d0,
2804 & 0.0d0,0.0d0,1.0d0/
2805 cd write(iout,*) 'In EELEC'
2807 cd write(iout,*) 'Type',i
2808 cd write(iout,*) 'B1',B1(:,i)
2809 cd write(iout,*) 'B2',B2(:,i)
2810 cd write(iout,*) 'CC',CC(:,:,i)
2811 cd write(iout,*) 'DD',DD(:,:,i)
2812 cd write(iout,*) 'EE',EE(:,:,i)
2814 cd call check_vecgrad
2816 if (icheckgrad.eq.1) then
2818 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2820 dc_norm(k,i)=dc(k,i)*fac
2822 c write (iout,*) 'i',i,' fac',fac
2825 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2826 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2827 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2828 c call vec_and_deriv
2834 time_mat=time_mat+MPI_Wtime()-time01
2838 cd write (iout,*) 'i=',i
2840 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2843 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2844 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2857 cd print '(a)','Enter EELEC'
2858 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2860 gel_loc_loc(i)=0.0d0
2865 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2867 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2869 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
2870 do i=iturn3_start,iturn3_end
2871 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2872 & .or. itype(i+2).eq.ntyp1
2873 & .or. itype(i+3).eq.ntyp1
2874 & .or. itype(i-1).eq.ntyp1
2875 & .or. itype(i+4).eq.ntyp1
2880 dx_normi=dc_norm(1,i)
2881 dy_normi=dc_norm(2,i)
2882 dz_normi=dc_norm(3,i)
2883 xmedi=c(1,i)+0.5d0*dxi
2884 ymedi=c(2,i)+0.5d0*dyi
2885 zmedi=c(3,i)+0.5d0*dzi
2886 C Return atom into box, boxxsize is size of box in x dimension
2888 if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2889 if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2890 C Condition for being inside the proper box
2891 if ((xmedi.gt.((0.5d0)*boxxsize)).or.
2892 & (xmedi.lt.((-0.5d0)*boxxsize))) then
2896 if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
2897 if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2898 C Condition for being inside the proper box
2899 if ((ymedi.gt.((0.5d0)*boxysize)).or.
2900 & (ymedi.lt.((-0.5d0)*boxysize))) then
2904 if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2905 if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2906 C Condition for being inside the proper box
2907 if ((zmedi.gt.((0.5d0)*boxzsize)).or.
2908 & (zmedi.lt.((-0.5d0)*boxzsize))) then
2912 call eelecij(i,i+2,ees,evdw1,eel_loc)
2913 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2914 num_cont_hb(i)=num_conti
2916 do i=iturn4_start,iturn4_end
2917 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2918 & .or. itype(i+3).eq.ntyp1
2919 & .or. itype(i+4).eq.ntyp1
2920 & .or. itype(i+5).eq.ntyp1
2921 & .or. itype(i).eq.ntyp1
2922 & .or. itype(i-1).eq.ntyp1
2927 dx_normi=dc_norm(1,i)
2928 dy_normi=dc_norm(2,i)
2929 dz_normi=dc_norm(3,i)
2930 xmedi=c(1,i)+0.5d0*dxi
2931 ymedi=c(2,i)+0.5d0*dyi
2932 zmedi=c(3,i)+0.5d0*dzi
2933 C Return atom into box, boxxsize is size of box in x dimension
2935 if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2936 if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2937 C Condition for being inside the proper box
2938 if ((xmedi.gt.((0.5d0)*boxxsize)).or.
2939 & (xmedi.lt.((-0.5d0)*boxxsize))) then
2943 if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
2944 if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2945 C Condition for being inside the proper box
2946 if ((ymedi.gt.((0.5d0)*boxysize)).or.
2947 & (ymedi.lt.((-0.5d0)*boxysize))) then
2951 if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2952 if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2953 C Condition for being inside the proper box
2954 if ((zmedi.gt.((0.5d0)*boxzsize)).or.
2955 & (zmedi.lt.((-0.5d0)*boxzsize))) then
2959 num_conti=num_cont_hb(i)
2960 call eelecij(i,i+3,ees,evdw1,eel_loc)
2961 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2962 & call eturn4(i,eello_turn4)
2963 num_cont_hb(i)=num_conti
2965 C Loop over all neighbouring boxes
2970 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2972 do i=iatel_s,iatel_e
2973 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2974 & .or. itype(i+2).eq.ntyp1
2975 & .or. itype(i-1).eq.ntyp1
2980 dx_normi=dc_norm(1,i)
2981 dy_normi=dc_norm(2,i)
2982 dz_normi=dc_norm(3,i)
2983 xmedi=c(1,i)+0.5d0*dxi
2984 ymedi=c(2,i)+0.5d0*dyi
2985 zmedi=c(3,i)+0.5d0*dzi
2986 C Return atom into box, boxxsize is size of box in x dimension
2988 if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2989 if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2990 C Condition for being inside the proper box
2991 if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
2992 & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
2996 if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
2997 if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2998 C Condition for being inside the proper box
2999 if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3000 & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3004 if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3005 if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3006 C Condition for being inside the proper box
3007 if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3008 & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3012 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3013 num_conti=num_cont_hb(i)
3014 do j=ielstart(i),ielend(i)
3015 c write (iout,*) i,j,itype(i),itype(j)
3016 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3017 & .or.itype(j+2).eq.ntyp1
3018 & .or.itype(j-1).eq.ntyp1
3020 call eelecij(i,j,ees,evdw1,eel_loc)
3022 num_cont_hb(i)=num_conti
3028 c write (iout,*) "Number of loop steps in EELEC:",ind
3030 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3031 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3033 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3034 ccc eel_loc=eel_loc+eello_turn3
3035 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3038 C-------------------------------------------------------------------------------
3039 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3040 implicit real*8 (a-h,o-z)
3041 include 'DIMENSIONS'
3045 include 'COMMON.CONTROL'
3046 include 'COMMON.IOUNITS'
3047 include 'COMMON.GEO'
3048 include 'COMMON.VAR'
3049 include 'COMMON.LOCAL'
3050 include 'COMMON.CHAIN'
3051 include 'COMMON.DERIV'
3052 include 'COMMON.INTERACT'
3053 include 'COMMON.CONTACTS'
3054 include 'COMMON.TORSION'
3055 include 'COMMON.VECTORS'
3056 include 'COMMON.FFIELD'
3057 include 'COMMON.TIME1'
3058 include 'COMMON.SPLITELE'
3059 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3060 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3061 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3062 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3063 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3064 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3066 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3068 double precision scal_el /1.0d0/
3070 double precision scal_el /0.5d0/
3073 C 13-go grudnia roku pamietnego...
3074 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3075 & 0.0d0,1.0d0,0.0d0,
3076 & 0.0d0,0.0d0,1.0d0/
3077 c time00=MPI_Wtime()
3078 cd write (iout,*) "eelecij",i,j
3082 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3083 aaa=app(iteli,itelj)
3084 bbb=bpp(iteli,itelj)
3085 ael6i=ael6(iteli,itelj)
3086 ael3i=ael3(iteli,itelj)
3090 dx_normj=dc_norm(1,j)
3091 dy_normj=dc_norm(2,j)
3092 dz_normj=dc_norm(3,j)
3093 C xj=c(1,j)+0.5D0*dxj-xmedi
3094 C yj=c(2,j)+0.5D0*dyj-ymedi
3095 C zj=c(3,j)+0.5D0*dzj-zmedi
3099 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3101 if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3102 if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3103 C Condition for being inside the proper box
3104 if ((xj.gt.((0.5d0)*boxxsize)).or.
3105 & (xj.lt.((-0.5d0)*boxxsize))) then
3109 if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3110 if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3111 C Condition for being inside the proper box
3112 if ((yj.gt.((0.5d0)*boxysize)).or.
3113 & (yj.lt.((-0.5d0)*boxysize))) then
3117 if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3118 if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3119 C Condition for being inside the proper box
3120 if ((zj.gt.((0.5d0)*boxzsize)).or.
3121 & (zj.lt.((-0.5d0)*boxzsize))) then
3124 C endif !endPBC condintion
3128 rij=xj*xj+yj*yj+zj*zj
3130 sss=sscale(sqrt(rij))
3131 sssgrad=sscagrad(sqrt(rij))
3132 c if (sss.gt.0.0d0) then
3138 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3139 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3140 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3141 fac=cosa-3.0D0*cosb*cosg
3143 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3144 if (j.eq.i+2) ev1=scal_el*ev1
3149 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3153 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3154 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3156 evdw1=evdw1+evdwij*sss
3157 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3158 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3159 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3160 cd & xmedi,ymedi,zmedi,xj,yj,zj
3162 if (energy_dec) then
3163 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3165 &,iteli,itelj,aaa,evdw1
3166 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3170 C Calculate contributions to the Cartesian gradient.
3173 facvdw=-6*rrmij*(ev1+evdwij)*sss
3174 facel=-3*rrmij*(el1+eesij)
3180 * Radial derivatives. First process both termini of the fragment (i,j)
3186 c ghalf=0.5D0*ggg(k)
3187 c gelc(k,i)=gelc(k,i)+ghalf
3188 c gelc(k,j)=gelc(k,j)+ghalf
3190 c 9/28/08 AL Gradient compotents will be summed only at the end
3192 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3193 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3196 * Loop over residues i+1 thru j-1.
3200 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3203 if (sss.gt.0.0) then
3204 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3205 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3206 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3213 c ghalf=0.5D0*ggg(k)
3214 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3215 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3217 c 9/28/08 AL Gradient compotents will be summed only at the end
3219 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3220 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3223 * Loop over residues i+1 thru j-1.
3227 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3232 facvdw=(ev1+evdwij)*sss
3235 fac=-3*rrmij*(facvdw+facvdw+facel)
3240 * Radial derivatives. First process both termini of the fragment (i,j)
3246 c ghalf=0.5D0*ggg(k)
3247 c gelc(k,i)=gelc(k,i)+ghalf
3248 c gelc(k,j)=gelc(k,j)+ghalf
3250 c 9/28/08 AL Gradient compotents will be summed only at the end
3252 gelc_long(k,j)=gelc(k,j)+ggg(k)
3253 gelc_long(k,i)=gelc(k,i)-ggg(k)
3256 * Loop over residues i+1 thru j-1.
3260 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3263 c 9/28/08 AL Gradient compotents will be summed only at the end
3264 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3265 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3266 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3268 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3269 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3275 ecosa=2.0D0*fac3*fac1+fac4
3278 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3279 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3281 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3282 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3284 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3285 cd & (dcosg(k),k=1,3)
3287 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3290 c ghalf=0.5D0*ggg(k)
3291 c gelc(k,i)=gelc(k,i)+ghalf
3292 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3293 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3294 c gelc(k,j)=gelc(k,j)+ghalf
3295 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3296 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3300 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3305 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3306 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3308 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3309 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3310 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3311 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3315 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3316 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3317 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3319 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3320 C energy of a peptide unit is assumed in the form of a second-order
3321 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3322 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3323 C are computed for EVERY pair of non-contiguous peptide groups.
3325 if (j.lt.nres-1) then
3336 muij(kkk)=mu(k,i)*mu(l,j)
3339 cd write (iout,*) 'EELEC: i',i,' j',j
3340 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3341 cd write(iout,*) 'muij',muij
3342 ury=scalar(uy(1,i),erij)
3343 urz=scalar(uz(1,i),erij)
3344 vry=scalar(uy(1,j),erij)
3345 vrz=scalar(uz(1,j),erij)
3346 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3347 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3348 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3349 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3350 fac=dsqrt(-ael6i)*r3ij
3355 cd write (iout,'(4i5,4f10.5)')
3356 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3357 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3358 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3359 cd & uy(:,j),uz(:,j)
3360 cd write (iout,'(4f10.5)')
3361 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3362 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3363 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3364 cd write (iout,'(9f10.5/)')
3365 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3366 C Derivatives of the elements of A in virtual-bond vectors
3367 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3369 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3370 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3371 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3372 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3373 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3374 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3375 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3376 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3377 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3378 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3379 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3380 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3382 C Compute radial contributions to the gradient
3400 C Add the contributions coming from er
3403 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3404 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3405 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3406 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3409 C Derivatives in DC(i)
3410 cgrad ghalf1=0.5d0*agg(k,1)
3411 cgrad ghalf2=0.5d0*agg(k,2)
3412 cgrad ghalf3=0.5d0*agg(k,3)
3413 cgrad ghalf4=0.5d0*agg(k,4)
3414 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3415 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3416 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3417 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3418 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3419 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3420 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3421 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3422 C Derivatives in DC(i+1)
3423 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3424 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3425 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3426 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3427 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3428 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3429 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3430 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3431 C Derivatives in DC(j)
3432 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3433 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3434 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3435 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3436 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3437 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3438 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3439 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3440 C Derivatives in DC(j+1) or DC(nres-1)
3441 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3442 & -3.0d0*vryg(k,3)*ury)
3443 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3444 & -3.0d0*vrzg(k,3)*ury)
3445 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3446 & -3.0d0*vryg(k,3)*urz)
3447 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3448 & -3.0d0*vrzg(k,3)*urz)
3449 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3451 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3464 aggi(k,l)=-aggi(k,l)
3465 aggi1(k,l)=-aggi1(k,l)
3466 aggj(k,l)=-aggj(k,l)
3467 aggj1(k,l)=-aggj1(k,l)
3470 if (j.lt.nres-1) then
3476 aggi(k,l)=-aggi(k,l)
3477 aggi1(k,l)=-aggi1(k,l)
3478 aggj(k,l)=-aggj(k,l)
3479 aggj1(k,l)=-aggj1(k,l)
3490 aggi(k,l)=-aggi(k,l)
3491 aggi1(k,l)=-aggi1(k,l)
3492 aggj(k,l)=-aggj(k,l)
3493 aggj1(k,l)=-aggj1(k,l)
3498 IF (wel_loc.gt.0.0d0) THEN
3499 C Contribution to the local-electrostatic energy coming from the i-j pair
3500 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3502 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3503 c & ' eel_loc_ij',eel_loc_ij
3505 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3506 & 'eelloc',i,j,eel_loc_ij
3507 c if (eel_loc_ij.ne.0)
3508 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3509 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3511 eel_loc=eel_loc+eel_loc_ij
3512 C Partial derivatives in virtual-bond dihedral angles gamma
3514 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3515 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3516 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3517 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3518 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3519 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3520 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3522 ggg(l)=agg(l,1)*muij(1)+
3523 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3524 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3525 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3526 cgrad ghalf=0.5d0*ggg(l)
3527 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3528 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3532 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3535 C Remaining derivatives of eello
3537 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3538 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3539 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3540 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3541 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3542 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3543 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3544 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3547 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3548 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3549 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3550 & .and. num_conti.le.maxconts) then
3551 c write (iout,*) i,j," entered corr"
3553 C Calculate the contact function. The ith column of the array JCONT will
3554 C contain the numbers of atoms that make contacts with the atom I (of numbers
3555 C greater than I). The arrays FACONT and GACONT will contain the values of
3556 C the contact function and its derivative.
3557 c r0ij=1.02D0*rpp(iteli,itelj)
3558 c r0ij=1.11D0*rpp(iteli,itelj)
3559 r0ij=2.20D0*rpp(iteli,itelj)
3560 c r0ij=1.55D0*rpp(iteli,itelj)
3561 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3562 if (fcont.gt.0.0D0) then
3563 num_conti=num_conti+1
3564 if (num_conti.gt.maxconts) then
3565 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3566 & ' will skip next contacts for this conf.'
3568 jcont_hb(num_conti,i)=j
3569 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3570 cd & " jcont_hb",jcont_hb(num_conti,i)
3571 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3572 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3573 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3575 d_cont(num_conti,i)=rij
3576 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3577 C --- Electrostatic-interaction matrix ---
3578 a_chuj(1,1,num_conti,i)=a22
3579 a_chuj(1,2,num_conti,i)=a23
3580 a_chuj(2,1,num_conti,i)=a32
3581 a_chuj(2,2,num_conti,i)=a33
3582 C --- Gradient of rij
3584 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3591 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3592 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3593 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3594 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3595 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3600 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3601 C Calculate contact energies
3603 wij=cosa-3.0D0*cosb*cosg
3606 c fac3=dsqrt(-ael6i)/r0ij**3
3607 fac3=dsqrt(-ael6i)*r3ij
3608 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3609 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3610 if (ees0tmp.gt.0) then
3611 ees0pij=dsqrt(ees0tmp)
3615 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3616 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3617 if (ees0tmp.gt.0) then
3618 ees0mij=dsqrt(ees0tmp)
3623 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3624 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3625 C Diagnostics. Comment out or remove after debugging!
3626 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3627 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3628 c ees0m(num_conti,i)=0.0D0
3630 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3631 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3632 C Angular derivatives of the contact function
3633 ees0pij1=fac3/ees0pij
3634 ees0mij1=fac3/ees0mij
3635 fac3p=-3.0D0*fac3*rrmij
3636 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3637 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3639 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3640 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3641 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3642 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3643 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3644 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3645 ecosap=ecosa1+ecosa2
3646 ecosbp=ecosb1+ecosb2
3647 ecosgp=ecosg1+ecosg2
3648 ecosam=ecosa1-ecosa2
3649 ecosbm=ecosb1-ecosb2
3650 ecosgm=ecosg1-ecosg2
3659 facont_hb(num_conti,i)=fcont
3660 fprimcont=fprimcont/rij
3661 cd facont_hb(num_conti,i)=1.0D0
3662 C Following line is for diagnostics.
3665 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3666 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3669 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3670 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3672 gggp(1)=gggp(1)+ees0pijp*xj
3673 gggp(2)=gggp(2)+ees0pijp*yj
3674 gggp(3)=gggp(3)+ees0pijp*zj
3675 gggm(1)=gggm(1)+ees0mijp*xj
3676 gggm(2)=gggm(2)+ees0mijp*yj
3677 gggm(3)=gggm(3)+ees0mijp*zj
3678 C Derivatives due to the contact function
3679 gacont_hbr(1,num_conti,i)=fprimcont*xj
3680 gacont_hbr(2,num_conti,i)=fprimcont*yj
3681 gacont_hbr(3,num_conti,i)=fprimcont*zj
3684 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3685 c following the change of gradient-summation algorithm.
3687 cgrad ghalfp=0.5D0*gggp(k)
3688 cgrad ghalfm=0.5D0*gggm(k)
3689 gacontp_hb1(k,num_conti,i)=!ghalfp
3690 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3691 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3692 gacontp_hb2(k,num_conti,i)=!ghalfp
3693 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3694 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3695 gacontp_hb3(k,num_conti,i)=gggp(k)
3696 gacontm_hb1(k,num_conti,i)=!ghalfm
3697 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3698 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3699 gacontm_hb2(k,num_conti,i)=!ghalfm
3700 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3701 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3702 gacontm_hb3(k,num_conti,i)=gggm(k)
3704 C Diagnostics. Comment out or remove after debugging!
3706 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3707 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3708 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3709 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3710 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3711 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3714 endif ! num_conti.le.maxconts
3717 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3720 ghalf=0.5d0*agg(l,k)
3721 aggi(l,k)=aggi(l,k)+ghalf
3722 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3723 aggj(l,k)=aggj(l,k)+ghalf
3726 if (j.eq.nres-1 .and. i.lt.j-2) then
3729 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3734 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3737 C-----------------------------------------------------------------------------
3738 subroutine eturn3(i,eello_turn3)
3739 C Third- and fourth-order contributions from turns
3740 implicit real*8 (a-h,o-z)
3741 include 'DIMENSIONS'
3742 include 'COMMON.IOUNITS'
3743 include 'COMMON.GEO'
3744 include 'COMMON.VAR'
3745 include 'COMMON.LOCAL'
3746 include 'COMMON.CHAIN'
3747 include 'COMMON.DERIV'
3748 include 'COMMON.INTERACT'
3749 include 'COMMON.CONTACTS'
3750 include 'COMMON.TORSION'
3751 include 'COMMON.VECTORS'
3752 include 'COMMON.FFIELD'
3753 include 'COMMON.CONTROL'
3755 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3756 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3757 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3758 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3759 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3760 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3761 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3764 c write (iout,*) "eturn3",i,j,j1,j2
3769 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3771 C Third-order contributions
3778 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3779 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3780 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3781 call transpose2(auxmat(1,1),auxmat1(1,1))
3782 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3783 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3784 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3785 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3786 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3787 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3788 cd & ' eello_turn3_num',4*eello_turn3_num
3789 C Derivatives in gamma(i)
3790 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3791 call transpose2(auxmat2(1,1),auxmat3(1,1))
3792 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3793 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3794 C Derivatives in gamma(i+1)
3795 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3796 call transpose2(auxmat2(1,1),auxmat3(1,1))
3797 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3798 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3799 & +0.5d0*(pizda(1,1)+pizda(2,2))
3800 C Cartesian derivatives
3802 c ghalf1=0.5d0*agg(l,1)
3803 c ghalf2=0.5d0*agg(l,2)
3804 c ghalf3=0.5d0*agg(l,3)
3805 c ghalf4=0.5d0*agg(l,4)
3806 a_temp(1,1)=aggi(l,1)!+ghalf1
3807 a_temp(1,2)=aggi(l,2)!+ghalf2
3808 a_temp(2,1)=aggi(l,3)!+ghalf3
3809 a_temp(2,2)=aggi(l,4)!+ghalf4
3810 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3811 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3812 & +0.5d0*(pizda(1,1)+pizda(2,2))
3813 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3814 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3815 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3816 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3817 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3818 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3819 & +0.5d0*(pizda(1,1)+pizda(2,2))
3820 a_temp(1,1)=aggj(l,1)!+ghalf1
3821 a_temp(1,2)=aggj(l,2)!+ghalf2
3822 a_temp(2,1)=aggj(l,3)!+ghalf3
3823 a_temp(2,2)=aggj(l,4)!+ghalf4
3824 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3825 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3826 & +0.5d0*(pizda(1,1)+pizda(2,2))
3827 a_temp(1,1)=aggj1(l,1)
3828 a_temp(1,2)=aggj1(l,2)
3829 a_temp(2,1)=aggj1(l,3)
3830 a_temp(2,2)=aggj1(l,4)
3831 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3832 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3833 & +0.5d0*(pizda(1,1)+pizda(2,2))
3837 C-------------------------------------------------------------------------------
3838 subroutine eturn4(i,eello_turn4)
3839 C Third- and fourth-order contributions from turns
3840 implicit real*8 (a-h,o-z)
3841 include 'DIMENSIONS'
3842 include 'COMMON.IOUNITS'
3843 include 'COMMON.GEO'
3844 include 'COMMON.VAR'
3845 include 'COMMON.LOCAL'
3846 include 'COMMON.CHAIN'
3847 include 'COMMON.DERIV'
3848 include 'COMMON.INTERACT'
3849 include 'COMMON.CONTACTS'
3850 include 'COMMON.TORSION'
3851 include 'COMMON.VECTORS'
3852 include 'COMMON.FFIELD'
3853 include 'COMMON.CONTROL'
3855 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3856 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3857 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3858 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3859 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3860 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3861 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3864 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3866 C Fourth-order contributions
3874 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3875 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3876 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3881 iti1=itortyp(itype(i+1))
3882 iti2=itortyp(itype(i+2))
3883 iti3=itortyp(itype(i+3))
3884 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3885 call transpose2(EUg(1,1,i+1),e1t(1,1))
3886 call transpose2(Eug(1,1,i+2),e2t(1,1))
3887 call transpose2(Eug(1,1,i+3),e3t(1,1))
3888 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3889 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3890 s1=scalar2(b1(1,iti2),auxvec(1))
3891 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3892 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3893 s2=scalar2(b1(1,iti1),auxvec(1))
3894 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3895 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3896 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3897 eello_turn4=eello_turn4-(s1+s2+s3)
3898 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
3899 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
3900 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
3901 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3902 cd & ' eello_turn4_num',8*eello_turn4_num
3903 C Derivatives in gamma(i)
3904 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3905 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3906 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3907 s1=scalar2(b1(1,iti2),auxvec(1))
3908 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3909 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3910 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3911 C Derivatives in gamma(i+1)
3912 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3913 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3914 s2=scalar2(b1(1,iti1),auxvec(1))
3915 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3916 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3917 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3918 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3919 C Derivatives in gamma(i+2)
3920 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3921 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3922 s1=scalar2(b1(1,iti2),auxvec(1))
3923 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3924 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3925 s2=scalar2(b1(1,iti1),auxvec(1))
3926 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3927 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3928 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3929 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3930 C Cartesian derivatives
3931 C Derivatives of this turn contributions in DC(i+2)
3932 if (j.lt.nres-1) then
3934 a_temp(1,1)=agg(l,1)
3935 a_temp(1,2)=agg(l,2)
3936 a_temp(2,1)=agg(l,3)
3937 a_temp(2,2)=agg(l,4)
3938 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3939 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3940 s1=scalar2(b1(1,iti2),auxvec(1))
3941 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3942 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3943 s2=scalar2(b1(1,iti1),auxvec(1))
3944 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3945 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3946 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3948 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3951 C Remaining derivatives of this turn contribution
3953 a_temp(1,1)=aggi(l,1)
3954 a_temp(1,2)=aggi(l,2)
3955 a_temp(2,1)=aggi(l,3)
3956 a_temp(2,2)=aggi(l,4)
3957 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3958 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3959 s1=scalar2(b1(1,iti2),auxvec(1))
3960 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3961 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3962 s2=scalar2(b1(1,iti1),auxvec(1))
3963 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3964 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3965 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3966 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3967 a_temp(1,1)=aggi1(l,1)
3968 a_temp(1,2)=aggi1(l,2)
3969 a_temp(2,1)=aggi1(l,3)
3970 a_temp(2,2)=aggi1(l,4)
3971 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3972 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3973 s1=scalar2(b1(1,iti2),auxvec(1))
3974 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3975 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3976 s2=scalar2(b1(1,iti1),auxvec(1))
3977 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3978 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3979 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3980 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3981 a_temp(1,1)=aggj(l,1)
3982 a_temp(1,2)=aggj(l,2)
3983 a_temp(2,1)=aggj(l,3)
3984 a_temp(2,2)=aggj(l,4)
3985 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3986 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3987 s1=scalar2(b1(1,iti2),auxvec(1))
3988 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3989 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3990 s2=scalar2(b1(1,iti1),auxvec(1))
3991 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3992 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3993 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3994 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3995 a_temp(1,1)=aggj1(l,1)
3996 a_temp(1,2)=aggj1(l,2)
3997 a_temp(2,1)=aggj1(l,3)
3998 a_temp(2,2)=aggj1(l,4)
3999 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4000 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4001 s1=scalar2(b1(1,iti2),auxvec(1))
4002 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4003 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4004 s2=scalar2(b1(1,iti1),auxvec(1))
4005 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4006 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4007 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4008 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4009 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4013 C-----------------------------------------------------------------------------
4014 subroutine vecpr(u,v,w)
4015 implicit real*8(a-h,o-z)
4016 dimension u(3),v(3),w(3)
4017 w(1)=u(2)*v(3)-u(3)*v(2)
4018 w(2)=-u(1)*v(3)+u(3)*v(1)
4019 w(3)=u(1)*v(2)-u(2)*v(1)
4022 C-----------------------------------------------------------------------------
4023 subroutine unormderiv(u,ugrad,unorm,ungrad)
4024 C This subroutine computes the derivatives of a normalized vector u, given
4025 C the derivatives computed without normalization conditions, ugrad. Returns
4028 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4029 double precision vec(3)
4030 double precision scalar
4032 c write (2,*) 'ugrad',ugrad
4035 vec(i)=scalar(ugrad(1,i),u(1))
4037 c write (2,*) 'vec',vec
4040 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4043 c write (2,*) 'ungrad',ungrad
4046 C-----------------------------------------------------------------------------
4047 subroutine escp_soft_sphere(evdw2,evdw2_14)
4049 C This subroutine calculates the excluded-volume interaction energy between
4050 C peptide-group centers and side chains and its gradient in virtual-bond and
4051 C side-chain vectors.
4053 implicit real*8 (a-h,o-z)
4054 include 'DIMENSIONS'
4055 include 'COMMON.GEO'
4056 include 'COMMON.VAR'
4057 include 'COMMON.LOCAL'
4058 include 'COMMON.CHAIN'
4059 include 'COMMON.DERIV'
4060 include 'COMMON.INTERACT'
4061 include 'COMMON.FFIELD'
4062 include 'COMMON.IOUNITS'
4063 include 'COMMON.CONTROL'
4068 cd print '(a)','Enter ESCP'
4069 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4073 do i=iatscp_s,iatscp_e
4074 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4076 xi=0.5D0*(c(1,i)+c(1,i+1))
4077 yi=0.5D0*(c(2,i)+c(2,i+1))
4078 zi=0.5D0*(c(3,i)+c(3,i+1))
4079 C Return atom into box, boxxsize is size of box in x dimension
4081 if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4082 if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4083 C Condition for being inside the proper box
4084 if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4085 & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4089 if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4090 if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4091 C Condition for being inside the proper box
4092 if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4093 & (yi.lt.((yshift-0.5d0)*boxysize))) then
4097 if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4098 if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4099 C Condition for being inside the proper box
4100 if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4101 & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4104 do iint=1,nscp_gr(i)
4106 do j=iscpstart(i,iint),iscpend(i,iint)
4107 if (itype(j).eq.ntyp1) cycle
4108 itypj=iabs(itype(j))
4109 C Uncomment following three lines for SC-p interactions
4113 C Uncomment following three lines for Ca-p interactions
4118 if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4119 if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4120 C Condition for being inside the proper box
4121 if ((xj.gt.((0.5d0)*boxxsize)).or.
4122 & (xj.lt.((-0.5d0)*boxxsize))) then
4126 if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4127 if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4128 C Condition for being inside the proper box
4129 if ((yj.gt.((0.5d0)*boxysize)).or.
4130 & (yj.lt.((-0.5d0)*boxysize))) then
4134 if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4135 if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4136 C Condition for being inside the proper box
4137 if ((zj.gt.((0.5d0)*boxzsize)).or.
4138 & (zj.lt.((-0.5d0)*boxzsize))) then
4144 rij=xj*xj+yj*yj+zj*zj
4148 if (rij.lt.r0ijsq) then
4149 evdwij=0.25d0*(rij-r0ijsq)**2
4157 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4162 cgrad if (j.lt.i) then
4163 cd write (iout,*) 'j<i'
4164 C Uncomment following three lines for SC-p interactions
4166 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4169 cd write (iout,*) 'j>i'
4171 cgrad ggg(k)=-ggg(k)
4172 C Uncomment following line for SC-p interactions
4173 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4177 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4179 cgrad kstart=min0(i+1,j)
4180 cgrad kend=max0(i-1,j-1)
4181 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4182 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4183 cgrad do k=kstart,kend
4185 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4189 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4190 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4201 C-----------------------------------------------------------------------------
4202 subroutine escp(evdw2,evdw2_14)
4204 C This subroutine calculates the excluded-volume interaction energy between
4205 C peptide-group centers and side chains and its gradient in virtual-bond and
4206 C side-chain vectors.
4208 implicit real*8 (a-h,o-z)
4209 include 'DIMENSIONS'
4210 include 'COMMON.GEO'
4211 include 'COMMON.VAR'
4212 include 'COMMON.LOCAL'
4213 include 'COMMON.CHAIN'
4214 include 'COMMON.DERIV'
4215 include 'COMMON.INTERACT'
4216 include 'COMMON.FFIELD'
4217 include 'COMMON.IOUNITS'
4218 include 'COMMON.CONTROL'
4219 include 'COMMON.SPLITELE'
4223 cd print '(a)','Enter ESCP'
4224 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4228 do i=iatscp_s,iatscp_e
4229 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4231 xi=0.5D0*(c(1,i)+c(1,i+1))
4232 yi=0.5D0*(c(2,i)+c(2,i+1))
4233 zi=0.5D0*(c(3,i)+c(3,i+1))
4234 C Return atom into box, boxxsize is size of box in x dimension
4236 if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4237 if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4238 C Condition for being inside the proper box
4239 if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4240 & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4244 if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4245 if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4246 C Condition for being inside the proper box
4247 if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4248 & (yi.lt.((yshift-0.5d0)*boxysize))) then
4252 if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4253 if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4254 C Condition for being inside the proper box
4255 if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4256 & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4259 do iint=1,nscp_gr(i)
4261 do j=iscpstart(i,iint),iscpend(i,iint)
4262 itypj=iabs(itype(j))
4263 if (itypj.eq.ntyp1) cycle
4264 C Uncomment following three lines for SC-p interactions
4268 C Uncomment following three lines for Ca-p interactions
4273 if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4274 if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4275 C Condition for being inside the proper box
4276 if ((xj.gt.((0.5d0)*boxxsize)).or.
4277 & (xj.lt.((-0.5d0)*boxxsize))) then
4281 if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4282 if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4283 C Condition for being inside the proper box
4284 if ((yj.gt.((0.5d0)*boxysize)).or.
4285 & (yj.lt.((-0.5d0)*boxysize))) then
4289 if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4290 if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4291 C Condition for being inside the proper box
4292 if ((zj.gt.((0.5d0)*boxzsize)).or.
4293 & (zj.lt.((-0.5d0)*boxzsize))) then
4299 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4300 sss=sscale(1.0d0/(dsqrt(rrij)))
4301 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4302 if (sss.gt.0.0d0) then
4304 e1=fac*fac*aad(itypj,iteli)
4305 e2=fac*bad(itypj,iteli)
4306 if (iabs(j-i) .le. 2) then
4309 evdw2_14=evdw2_14+(e1+e2)*sss
4312 evdw2=evdw2+evdwij*sss
4313 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4314 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4317 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4319 fac=-(evdwij+e1)*rrij*sss
4320 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4324 cgrad if (j.lt.i) then
4325 cd write (iout,*) 'j<i'
4326 C Uncomment following three lines for SC-p interactions
4328 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4331 cd write (iout,*) 'j>i'
4333 cgrad ggg(k)=-ggg(k)
4334 C Uncomment following line for SC-p interactions
4335 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4336 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4340 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4342 cgrad kstart=min0(i+1,j)
4343 cgrad kend=max0(i-1,j-1)
4344 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4345 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4346 cgrad do k=kstart,kend
4348 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4352 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4353 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4355 endif !endif for sscale cutoff
4365 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4366 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4367 gradx_scp(j,i)=expon*gradx_scp(j,i)
4370 C******************************************************************************
4374 C To save time the factor EXPON has been extracted from ALL components
4375 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4378 C******************************************************************************
4381 C--------------------------------------------------------------------------
4382 subroutine edis(ehpb)
4384 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4386 implicit real*8 (a-h,o-z)
4387 include 'DIMENSIONS'
4388 include 'COMMON.SBRIDGE'
4389 include 'COMMON.CHAIN'
4390 include 'COMMON.DERIV'
4391 include 'COMMON.VAR'
4392 include 'COMMON.INTERACT'
4393 include 'COMMON.IOUNITS'
4396 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4397 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4398 if (link_end.eq.0) return
4399 do i=link_start,link_end
4400 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4401 C CA-CA distance used in regularization of structure.
4404 C iii and jjj point to the residues for which the distance is assigned.
4405 if (ii.gt.nres) then
4412 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4413 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4414 C distance and angle dependent SS bond potential.
4415 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4416 & iabs(itype(jjj)).eq.1) then
4417 call ssbond_ene(iii,jjj,eij)
4419 cd write (iout,*) "eij",eij
4421 C Calculate the distance between the two points and its difference from the
4425 C Get the force constant corresponding to this distance.
4427 C Calculate the contribution to energy.
4428 ehpb=ehpb+waga*rdis*rdis
4430 C Evaluate gradient.
4433 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4434 cd & ' waga=',waga,' fac=',fac
4436 ggg(j)=fac*(c(j,jj)-c(j,ii))
4438 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4439 C If this is a SC-SC distance, we need to calculate the contributions to the
4440 C Cartesian gradient in the SC vectors (ghpbx).
4443 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4444 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4447 cgrad do j=iii,jjj-1
4449 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4453 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4454 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4461 C--------------------------------------------------------------------------
4462 subroutine ssbond_ene(i,j,eij)
4464 C Calculate the distance and angle dependent SS-bond potential energy
4465 C using a free-energy function derived based on RHF/6-31G** ab initio
4466 C calculations of diethyl disulfide.
4468 C A. Liwo and U. Kozlowska, 11/24/03
4470 implicit real*8 (a-h,o-z)
4471 include 'DIMENSIONS'
4472 include 'COMMON.SBRIDGE'
4473 include 'COMMON.CHAIN'
4474 include 'COMMON.DERIV'
4475 include 'COMMON.LOCAL'
4476 include 'COMMON.INTERACT'
4477 include 'COMMON.VAR'
4478 include 'COMMON.IOUNITS'
4479 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4480 itypi=iabs(itype(i))
4484 dxi=dc_norm(1,nres+i)
4485 dyi=dc_norm(2,nres+i)
4486 dzi=dc_norm(3,nres+i)
4487 c dsci_inv=dsc_inv(itypi)
4488 dsci_inv=vbld_inv(nres+i)
4489 itypj=iabs(itype(j))
4490 c dscj_inv=dsc_inv(itypj)
4491 dscj_inv=vbld_inv(nres+j)
4495 dxj=dc_norm(1,nres+j)
4496 dyj=dc_norm(2,nres+j)
4497 dzj=dc_norm(3,nres+j)
4498 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4503 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4504 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4505 om12=dxi*dxj+dyi*dyj+dzi*dzj
4507 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4508 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4514 deltat12=om2-om1+2.0d0
4516 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4517 & +akct*deltad*deltat12
4518 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4519 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4520 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4521 c & " deltat12",deltat12," eij",eij
4522 ed=2*akcm*deltad+akct*deltat12
4524 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4525 eom1=-2*akth*deltat1-pom1-om2*pom2
4526 eom2= 2*akth*deltat2+pom1-om1*pom2
4529 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4530 ghpbx(k,i)=ghpbx(k,i)-ggk
4531 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4532 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4533 ghpbx(k,j)=ghpbx(k,j)+ggk
4534 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4535 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4536 ghpbc(k,i)=ghpbc(k,i)-ggk
4537 ghpbc(k,j)=ghpbc(k,j)+ggk
4540 C Calculate the components of the gradient in DC and X
4544 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4549 C--------------------------------------------------------------------------
4550 subroutine ebond(estr)
4552 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4554 implicit real*8 (a-h,o-z)
4555 include 'DIMENSIONS'
4556 include 'COMMON.LOCAL'
4557 include 'COMMON.GEO'
4558 include 'COMMON.INTERACT'
4559 include 'COMMON.DERIV'
4560 include 'COMMON.VAR'
4561 include 'COMMON.CHAIN'
4562 include 'COMMON.IOUNITS'
4563 include 'COMMON.NAMES'
4564 include 'COMMON.FFIELD'
4565 include 'COMMON.CONTROL'
4566 include 'COMMON.SETUP'
4567 double precision u(3),ud(3)
4570 do i=ibondp_start,ibondp_end
4571 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4572 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4574 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4575 c & *dc(j,i-1)/vbld(i)
4577 c if (energy_dec) write(iout,*)
4578 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4580 C Checking if it involves dummy (NH3+ or COO-) group
4581 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4582 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
4583 diff = vbld(i)-vbldpDUM
4585 C NO vbldp0 is the equlibrium lenght of spring for peptide group
4586 diff = vbld(i)-vbldp0
4588 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
4589 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4592 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4594 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4597 estr=0.5d0*AKP*estr+estr1
4599 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4601 do i=ibond_start,ibond_end
4603 if (iti.ne.10 .and. iti.ne.ntyp1) then
4606 diff=vbld(i+nres)-vbldsc0(1,iti)
4607 if (energy_dec) write (iout,*)
4608 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4609 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4610 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4612 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4616 diff=vbld(i+nres)-vbldsc0(j,iti)
4617 ud(j)=aksc(j,iti)*diff
4618 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4632 uprod2=uprod2*u(k)*u(k)
4636 usumsqder=usumsqder+ud(j)*uprod2
4638 estr=estr+uprod/usum
4640 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4648 C--------------------------------------------------------------------------
4649 subroutine ebend(etheta)
4651 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4652 C angles gamma and its derivatives in consecutive thetas and gammas.
4654 implicit real*8 (a-h,o-z)
4655 include 'DIMENSIONS'
4656 include 'COMMON.LOCAL'
4657 include 'COMMON.GEO'
4658 include 'COMMON.INTERACT'
4659 include 'COMMON.DERIV'
4660 include 'COMMON.VAR'
4661 include 'COMMON.CHAIN'
4662 include 'COMMON.IOUNITS'
4663 include 'COMMON.NAMES'
4664 include 'COMMON.FFIELD'
4665 include 'COMMON.CONTROL'
4666 common /calcthet/ term1,term2,termm,diffak,ratak,
4667 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4668 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4669 double precision y(2),z(2)
4671 c time11=dexp(-2*time)
4674 c write (*,'(a,i2)') 'EBEND ICG=',icg
4675 do i=ithet_start,ithet_end
4676 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4677 & .or.itype(i).eq.ntyp1) cycle
4678 C Zero the energy function and its derivative at 0 or pi.
4679 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4681 ichir1=isign(1,itype(i-2))
4682 ichir2=isign(1,itype(i))
4683 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4684 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4685 if (itype(i-1).eq.10) then
4686 itype1=isign(10,itype(i-2))
4687 ichir11=isign(1,itype(i-2))
4688 ichir12=isign(1,itype(i-2))
4689 itype2=isign(10,itype(i))
4690 ichir21=isign(1,itype(i))
4691 ichir22=isign(1,itype(i))
4694 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4697 if (phii.ne.phii) phii=150.0
4707 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4710 if (phii1.ne.phii1) phii1=150.0
4722 C Calculate the "mean" value of theta from the part of the distribution
4723 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4724 C In following comments this theta will be referred to as t_c.
4725 thet_pred_mean=0.0d0
4727 athetk=athet(k,it,ichir1,ichir2)
4728 bthetk=bthet(k,it,ichir1,ichir2)
4730 athetk=athet(k,itype1,ichir11,ichir12)
4731 bthetk=bthet(k,itype2,ichir21,ichir22)
4733 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4734 c write(iout,*) 'chuj tu', y(k),z(k)
4736 dthett=thet_pred_mean*ssd
4737 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4738 C Derivatives of the "mean" values in gamma1 and gamma2.
4739 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4740 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4741 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4742 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4744 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4745 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4746 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4747 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4749 if (theta(i).gt.pi-delta) then
4750 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4752 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4753 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4754 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4756 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4758 else if (theta(i).lt.delta) then
4759 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4760 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4761 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4763 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4764 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4767 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4770 etheta=etheta+ethetai
4771 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4772 & 'ebend',i,ethetai,theta(i),itype(i)
4773 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4774 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4775 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
4777 C Ufff.... We've done all this!!!
4780 C---------------------------------------------------------------------------
4781 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4783 implicit real*8 (a-h,o-z)
4784 include 'DIMENSIONS'
4785 include 'COMMON.LOCAL'
4786 include 'COMMON.IOUNITS'
4787 common /calcthet/ term1,term2,termm,diffak,ratak,
4788 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4789 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4790 C Calculate the contributions to both Gaussian lobes.
4791 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4792 C The "polynomial part" of the "standard deviation" of this part of
4793 C the distributioni.
4794 ccc write (iout,*) thetai,thet_pred_mean
4797 sig=sig*thet_pred_mean+polthet(j,it)
4799 C Derivative of the "interior part" of the "standard deviation of the"
4800 C gamma-dependent Gaussian lobe in t_c.
4801 sigtc=3*polthet(3,it)
4803 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4806 C Set the parameters of both Gaussian lobes of the distribution.
4807 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4808 fac=sig*sig+sigc0(it)
4811 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4812 sigsqtc=-4.0D0*sigcsq*sigtc
4813 c print *,i,sig,sigtc,sigsqtc
4814 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4815 sigtc=-sigtc/(fac*fac)
4816 C Following variable is sigma(t_c)**(-2)
4817 sigcsq=sigcsq*sigcsq
4819 sig0inv=1.0D0/sig0i**2
4820 delthec=thetai-thet_pred_mean
4821 delthe0=thetai-theta0i
4822 term1=-0.5D0*sigcsq*delthec*delthec
4823 term2=-0.5D0*sig0inv*delthe0*delthe0
4824 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
4825 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4826 C NaNs in taking the logarithm. We extract the largest exponent which is added
4827 C to the energy (this being the log of the distribution) at the end of energy
4828 C term evaluation for this virtual-bond angle.
4829 if (term1.gt.term2) then
4831 term2=dexp(term2-termm)
4835 term1=dexp(term1-termm)
4838 C The ratio between the gamma-independent and gamma-dependent lobes of
4839 C the distribution is a Gaussian function of thet_pred_mean too.
4840 diffak=gthet(2,it)-thet_pred_mean
4841 ratak=diffak/gthet(3,it)**2
4842 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4843 C Let's differentiate it in thet_pred_mean NOW.
4845 C Now put together the distribution terms to make complete distribution.
4846 termexp=term1+ak*term2
4847 termpre=sigc+ak*sig0i
4848 C Contribution of the bending energy from this theta is just the -log of
4849 C the sum of the contributions from the two lobes and the pre-exponential
4850 C factor. Simple enough, isn't it?
4851 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4852 C write (iout,*) 'termexp',termexp,termm,termpre,i
4853 C NOW the derivatives!!!
4854 C 6/6/97 Take into account the deformation.
4855 E_theta=(delthec*sigcsq*term1
4856 & +ak*delthe0*sig0inv*term2)/termexp
4857 E_tc=((sigtc+aktc*sig0i)/termpre
4858 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4859 & aktc*term2)/termexp)
4862 c-----------------------------------------------------------------------------
4863 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4864 implicit real*8 (a-h,o-z)
4865 include 'DIMENSIONS'
4866 include 'COMMON.LOCAL'
4867 include 'COMMON.IOUNITS'
4868 common /calcthet/ term1,term2,termm,diffak,ratak,
4869 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4870 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4871 delthec=thetai-thet_pred_mean
4872 delthe0=thetai-theta0i
4873 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4874 t3 = thetai-thet_pred_mean
4878 t14 = t12+t6*sigsqtc
4880 t21 = thetai-theta0i
4886 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4887 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4888 & *(-t12*t9-ak*sig0inv*t27)
4892 C--------------------------------------------------------------------------
4893 subroutine ebend(etheta)
4895 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4896 C angles gamma and its derivatives in consecutive thetas and gammas.
4897 C ab initio-derived potentials from
4898 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4900 implicit real*8 (a-h,o-z)
4901 include 'DIMENSIONS'
4902 include 'COMMON.LOCAL'
4903 include 'COMMON.GEO'
4904 include 'COMMON.INTERACT'
4905 include 'COMMON.DERIV'
4906 include 'COMMON.VAR'
4907 include 'COMMON.CHAIN'
4908 include 'COMMON.IOUNITS'
4909 include 'COMMON.NAMES'
4910 include 'COMMON.FFIELD'
4911 include 'COMMON.CONTROL'
4912 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4913 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4914 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4915 & sinph1ph2(maxdouble,maxdouble)
4916 logical lprn /.false./, lprn1 /.false./
4918 do i=ithet_start,ithet_end
4919 c print *,i,itype(i-1),itype(i),itype(i-2)
4920 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4921 & .or.itype(i).eq.ntyp1) cycle
4922 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
4924 if (iabs(itype(i+1)).eq.20) iblock=2
4925 if (iabs(itype(i+1)).ne.20) iblock=1
4929 theti2=0.5d0*theta(i)
4930 ityp2=ithetyp((itype(i-1)))
4932 coskt(k)=dcos(k*theti2)
4933 sinkt(k)=dsin(k*theti2)
4935 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4938 if (phii.ne.phii) phii=150.0
4942 ityp1=ithetyp((itype(i-2)))
4943 C propagation of chirality for glycine type
4945 cosph1(k)=dcos(k*phii)
4946 sinph1(k)=dsin(k*phii)
4956 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4959 if (phii1.ne.phii1) phii1=150.0
4964 ityp3=ithetyp((itype(i)))
4966 cosph2(k)=dcos(k*phii1)
4967 sinph2(k)=dsin(k*phii1)
4977 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4980 ccl=cosph1(l)*cosph2(k-l)
4981 ssl=sinph1(l)*sinph2(k-l)
4982 scl=sinph1(l)*cosph2(k-l)
4983 csl=cosph1(l)*sinph2(k-l)
4984 cosph1ph2(l,k)=ccl-ssl
4985 cosph1ph2(k,l)=ccl+ssl
4986 sinph1ph2(l,k)=scl+csl
4987 sinph1ph2(k,l)=scl-csl
4991 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4992 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4993 write (iout,*) "coskt and sinkt"
4995 write (iout,*) k,coskt(k),sinkt(k)
4999 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5000 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5003 & write (iout,*) "k",k,"
5004 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5005 & " ethetai",ethetai
5008 write (iout,*) "cosph and sinph"
5010 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5012 write (iout,*) "cosph1ph2 and sinph2ph2"
5015 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5016 & sinph1ph2(l,k),sinph1ph2(k,l)
5019 write(iout,*) "ethetai",ethetai
5023 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5024 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5025 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5026 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5027 ethetai=ethetai+sinkt(m)*aux
5028 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5029 dephii=dephii+k*sinkt(m)*(
5030 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5031 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5032 dephii1=dephii1+k*sinkt(m)*(
5033 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5034 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5036 & write (iout,*) "m",m," k",k," bbthet",
5037 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5038 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5039 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5040 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5044 & write(iout,*) "ethetai",ethetai
5048 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5049 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5050 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5051 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5052 ethetai=ethetai+sinkt(m)*aux
5053 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5054 dephii=dephii+l*sinkt(m)*(
5055 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5056 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5057 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5058 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5059 dephii1=dephii1+(k-l)*sinkt(m)*(
5060 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5061 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5062 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5063 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5065 write (iout,*) "m",m," k",k," l",l," ffthet",
5066 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5067 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5068 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5069 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5070 & " ethetai",ethetai
5071 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5072 & cosph1ph2(k,l)*sinkt(m),
5073 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5081 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5082 & i,theta(i)*rad2deg,phii*rad2deg,
5083 & phii1*rad2deg,ethetai
5085 etheta=etheta+ethetai
5086 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5087 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5088 gloc(nphi+i-2,icg)=wang*dethetai+ gloc(nphi+i-2,icg)
5094 c-----------------------------------------------------------------------------
5095 subroutine esc(escloc)
5096 C Calculate the local energy of a side chain and its derivatives in the
5097 C corresponding virtual-bond valence angles THETA and the spherical angles
5099 implicit real*8 (a-h,o-z)
5100 include 'DIMENSIONS'
5101 include 'COMMON.GEO'
5102 include 'COMMON.LOCAL'
5103 include 'COMMON.VAR'
5104 include 'COMMON.INTERACT'
5105 include 'COMMON.DERIV'
5106 include 'COMMON.CHAIN'
5107 include 'COMMON.IOUNITS'
5108 include 'COMMON.NAMES'
5109 include 'COMMON.FFIELD'
5110 include 'COMMON.CONTROL'
5111 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5112 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5113 common /sccalc/ time11,time12,time112,theti,it,nlobit
5116 c write (iout,'(a)') 'ESC'
5117 do i=loc_start,loc_end
5119 if (it.eq.ntyp1) cycle
5120 if (it.eq.10) goto 1
5121 nlobit=nlob(iabs(it))
5122 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5123 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5124 theti=theta(i+1)-pipol
5129 if (x(2).gt.pi-delta) then
5133 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5135 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5136 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5138 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5139 & ddersc0(1),dersc(1))
5140 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5141 & ddersc0(3),dersc(3))
5143 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5145 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5146 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5147 & dersc0(2),esclocbi,dersc02)
5148 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5150 call splinthet(x(2),0.5d0*delta,ss,ssd)
5155 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5157 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5158 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5160 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5162 c write (iout,*) escloci
5163 else if (x(2).lt.delta) then
5167 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5169 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5170 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5172 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5173 & ddersc0(1),dersc(1))
5174 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5175 & ddersc0(3),dersc(3))
5177 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5179 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5180 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5181 & dersc0(2),esclocbi,dersc02)
5182 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5187 call splinthet(x(2),0.5d0*delta,ss,ssd)
5189 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5191 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5192 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5194 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5195 c write (iout,*) escloci
5197 call enesc(x,escloci,dersc,ddummy,.false.)
5200 escloc=escloc+escloci
5201 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5202 & 'escloc',i,escloci
5203 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5205 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5207 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5208 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5213 C---------------------------------------------------------------------------
5214 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5215 implicit real*8 (a-h,o-z)
5216 include 'DIMENSIONS'
5217 include 'COMMON.GEO'
5218 include 'COMMON.LOCAL'
5219 include 'COMMON.IOUNITS'
5220 common /sccalc/ time11,time12,time112,theti,it,nlobit
5221 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5222 double precision contr(maxlob,-1:1)
5224 c write (iout,*) 'it=',it,' nlobit=',nlobit
5228 if (mixed) ddersc(j)=0.0d0
5232 C Because of periodicity of the dependence of the SC energy in omega we have
5233 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5234 C To avoid underflows, first compute & store the exponents.
5242 z(k)=x(k)-censc(k,j,it)
5247 Axk=Axk+gaussc(l,k,j,it)*z(l)
5253 expfac=expfac+Ax(k,j,iii)*z(k)
5261 C As in the case of ebend, we want to avoid underflows in exponentiation and
5262 C subsequent NaNs and INFs in energy calculation.
5263 C Find the largest exponent
5267 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5271 cd print *,'it=',it,' emin=',emin
5273 C Compute the contribution to SC energy and derivatives
5278 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5279 if(adexp.ne.adexp) adexp=1.0
5282 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5284 cd print *,'j=',j,' expfac=',expfac
5285 escloc_i=escloc_i+expfac
5287 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5291 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5292 & +gaussc(k,2,j,it))*expfac
5299 dersc(1)=dersc(1)/cos(theti)**2
5300 ddersc(1)=ddersc(1)/cos(theti)**2
5303 escloci=-(dlog(escloc_i)-emin)
5305 dersc(j)=dersc(j)/escloc_i
5309 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5314 C------------------------------------------------------------------------------
5315 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5316 implicit real*8 (a-h,o-z)
5317 include 'DIMENSIONS'
5318 include 'COMMON.GEO'
5319 include 'COMMON.LOCAL'
5320 include 'COMMON.IOUNITS'
5321 common /sccalc/ time11,time12,time112,theti,it,nlobit
5322 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5323 double precision contr(maxlob)
5334 z(k)=x(k)-censc(k,j,it)
5340 Axk=Axk+gaussc(l,k,j,it)*z(l)
5346 expfac=expfac+Ax(k,j)*z(k)
5351 C As in the case of ebend, we want to avoid underflows in exponentiation and
5352 C subsequent NaNs and INFs in energy calculation.
5353 C Find the largest exponent
5356 if (emin.gt.contr(j)) emin=contr(j)
5360 C Compute the contribution to SC energy and derivatives
5364 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5365 escloc_i=escloc_i+expfac
5367 dersc(k)=dersc(k)+Ax(k,j)*expfac
5369 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5370 & +gaussc(1,2,j,it))*expfac
5374 dersc(1)=dersc(1)/cos(theti)**2
5375 dersc12=dersc12/cos(theti)**2
5376 escloci=-(dlog(escloc_i)-emin)
5378 dersc(j)=dersc(j)/escloc_i
5380 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5384 c----------------------------------------------------------------------------------
5385 subroutine esc(escloc)
5386 C Calculate the local energy of a side chain and its derivatives in the
5387 C corresponding virtual-bond valence angles THETA and the spherical angles
5388 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5389 C added by Urszula Kozlowska. 07/11/2007
5391 implicit real*8 (a-h,o-z)
5392 include 'DIMENSIONS'
5393 include 'COMMON.GEO'
5394 include 'COMMON.LOCAL'
5395 include 'COMMON.VAR'
5396 include 'COMMON.SCROT'
5397 include 'COMMON.INTERACT'
5398 include 'COMMON.DERIV'
5399 include 'COMMON.CHAIN'
5400 include 'COMMON.IOUNITS'
5401 include 'COMMON.NAMES'
5402 include 'COMMON.FFIELD'
5403 include 'COMMON.CONTROL'
5404 include 'COMMON.VECTORS'
5405 double precision x_prime(3),y_prime(3),z_prime(3)
5406 & , sumene,dsc_i,dp2_i,x(65),
5407 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5408 & de_dxx,de_dyy,de_dzz,de_dt
5409 double precision s1_t,s1_6_t,s2_t,s2_6_t
5411 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5412 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5413 & dt_dCi(3),dt_dCi1(3)
5414 common /sccalc/ time11,time12,time112,theti,it,nlobit
5417 do i=loc_start,loc_end
5418 if (itype(i).eq.ntyp1) cycle
5419 costtab(i+1) =dcos(theta(i+1))
5420 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5421 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5422 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5423 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5424 cosfac=dsqrt(cosfac2)
5425 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5426 sinfac=dsqrt(sinfac2)
5428 if (it.eq.10) goto 1
5430 C Compute the axes of tghe local cartesian coordinates system; store in
5431 c x_prime, y_prime and z_prime
5438 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5439 C & dc_norm(3,i+nres)
5441 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5442 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5445 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5448 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5449 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5450 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5451 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5452 c & " xy",scalar(x_prime(1),y_prime(1)),
5453 c & " xz",scalar(x_prime(1),z_prime(1)),
5454 c & " yy",scalar(y_prime(1),y_prime(1)),
5455 c & " yz",scalar(y_prime(1),z_prime(1)),
5456 c & " zz",scalar(z_prime(1),z_prime(1))
5458 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5459 C to local coordinate system. Store in xx, yy, zz.
5465 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5466 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5467 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5474 C Compute the energy of the ith side cbain
5476 c write (2,*) "xx",xx," yy",yy," zz",zz
5479 x(j) = sc_parmin(j,it)
5482 Cc diagnostics - remove later
5484 yy1 = dsin(alph(2))*dcos(omeg(2))
5485 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5486 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5487 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5489 C," --- ", xx_w,yy_w,zz_w
5492 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5493 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5495 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5496 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5498 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5499 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5500 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5501 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5502 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5504 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5505 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5506 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5507 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5508 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5510 dsc_i = 0.743d0+x(61)
5512 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5513 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5514 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5515 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5516 s1=(1+x(63))/(0.1d0 + dscp1)
5517 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5518 s2=(1+x(65))/(0.1d0 + dscp2)
5519 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5520 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5521 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5522 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5524 c & dscp1,dscp2,sumene
5525 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5526 escloc = escloc + sumene
5527 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5532 C This section to check the numerical derivatives of the energy of ith side
5533 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5534 C #define DEBUG in the code to turn it on.
5536 write (2,*) "sumene =",sumene
5540 write (2,*) xx,yy,zz
5541 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5542 de_dxx_num=(sumenep-sumene)/aincr
5544 write (2,*) "xx+ sumene from enesc=",sumenep
5547 write (2,*) xx,yy,zz
5548 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5549 de_dyy_num=(sumenep-sumene)/aincr
5551 write (2,*) "yy+ sumene from enesc=",sumenep
5554 write (2,*) xx,yy,zz
5555 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5556 de_dzz_num=(sumenep-sumene)/aincr
5558 write (2,*) "zz+ sumene from enesc=",sumenep
5559 costsave=cost2tab(i+1)
5560 sintsave=sint2tab(i+1)
5561 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5562 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5563 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5564 de_dt_num=(sumenep-sumene)/aincr
5565 write (2,*) " t+ sumene from enesc=",sumenep
5566 cost2tab(i+1)=costsave
5567 sint2tab(i+1)=sintsave
5568 C End of diagnostics section.
5571 C Compute the gradient of esc
5573 c zz=zz*dsign(1.0,dfloat(itype(i)))
5574 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5575 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5576 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5577 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5578 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5579 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5580 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5581 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5582 pom1=(sumene3*sint2tab(i+1)+sumene1)
5583 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5584 pom2=(sumene4*cost2tab(i+1)+sumene2)
5585 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5586 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5587 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5588 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5590 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5591 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5592 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5594 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5595 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5596 & +(pom1+pom2)*pom_dx
5598 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5601 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5602 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5603 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5605 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5606 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5607 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5608 & +x(59)*zz**2 +x(60)*xx*zz
5609 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5610 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5611 & +(pom1-pom2)*pom_dy
5613 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5616 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5617 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5618 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5619 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5620 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5621 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5622 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5623 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5625 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5628 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5629 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5630 & +pom1*pom_dt1+pom2*pom_dt2
5632 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5637 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5638 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5639 cosfac2xx=cosfac2*xx
5640 sinfac2yy=sinfac2*yy
5642 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5644 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5646 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5647 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5648 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5649 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5650 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5651 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5652 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5653 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5654 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5655 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5659 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5660 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5661 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5662 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5665 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5666 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5667 dZZ_XYZ(k)=vbld_inv(i+nres)*
5668 & (z_prime(k)-zz*dC_norm(k,i+nres))
5670 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5671 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5675 dXX_Ctab(k,i)=dXX_Ci(k)
5676 dXX_C1tab(k,i)=dXX_Ci1(k)
5677 dYY_Ctab(k,i)=dYY_Ci(k)
5678 dYY_C1tab(k,i)=dYY_Ci1(k)
5679 dZZ_Ctab(k,i)=dZZ_Ci(k)
5680 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5681 dXX_XYZtab(k,i)=dXX_XYZ(k)
5682 dYY_XYZtab(k,i)=dYY_XYZ(k)
5683 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5687 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5688 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5689 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5690 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5691 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5693 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5694 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5695 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5696 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5697 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5698 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5699 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5700 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5702 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5703 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5705 C to check gradient call subroutine check_grad
5711 c------------------------------------------------------------------------------
5712 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5714 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5715 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5716 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5717 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5719 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5720 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5722 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5723 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5724 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5725 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5726 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5728 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5729 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5730 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5731 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5732 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5734 dsc_i = 0.743d0+x(61)
5736 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5737 & *(xx*cost2+yy*sint2))
5738 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5739 & *(xx*cost2-yy*sint2))
5740 s1=(1+x(63))/(0.1d0 + dscp1)
5741 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5742 s2=(1+x(65))/(0.1d0 + dscp2)
5743 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5744 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5745 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5750 c------------------------------------------------------------------------------
5751 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5753 C This procedure calculates two-body contact function g(rij) and its derivative:
5756 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5759 C where x=(rij-r0ij)/delta
5761 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5764 double precision rij,r0ij,eps0ij,fcont,fprimcont
5765 double precision x,x2,x4,delta
5769 if (x.lt.-1.0D0) then
5772 else if (x.le.1.0D0) then
5775 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5776 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5783 c------------------------------------------------------------------------------
5784 subroutine splinthet(theti,delta,ss,ssder)
5785 implicit real*8 (a-h,o-z)
5786 include 'DIMENSIONS'
5787 include 'COMMON.VAR'
5788 include 'COMMON.GEO'
5791 if (theti.gt.pipol) then
5792 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5794 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5799 c------------------------------------------------------------------------------
5800 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5802 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5803 double precision ksi,ksi2,ksi3,a1,a2,a3
5804 a1=fprim0*delta/(f1-f0)
5810 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5811 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5814 c------------------------------------------------------------------------------
5815 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5817 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5818 double precision ksi,ksi2,ksi3,a1,a2,a3
5823 a2=3*(f1x-f0x)-2*fprim0x*delta
5824 a3=fprim0x*delta-2*(f1x-f0x)
5825 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5828 C-----------------------------------------------------------------------------
5830 C-----------------------------------------------------------------------------
5831 subroutine etor(etors,edihcnstr)
5832 implicit real*8 (a-h,o-z)
5833 include 'DIMENSIONS'
5834 include 'COMMON.VAR'
5835 include 'COMMON.GEO'
5836 include 'COMMON.LOCAL'
5837 include 'COMMON.TORSION'
5838 include 'COMMON.INTERACT'
5839 include 'COMMON.DERIV'
5840 include 'COMMON.CHAIN'
5841 include 'COMMON.NAMES'
5842 include 'COMMON.IOUNITS'
5843 include 'COMMON.FFIELD'
5844 include 'COMMON.TORCNSTR'
5845 include 'COMMON.CONTROL'
5847 C Set lprn=.true. for debugging
5851 do i=iphi_start,iphi_end
5853 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5854 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5855 itori=itortyp(itype(i-2))
5856 itori1=itortyp(itype(i-1))
5859 C Proline-Proline pair is a special case...
5860 if (itori.eq.3 .and. itori1.eq.3) then
5861 if (phii.gt.-dwapi3) then
5863 fac=1.0D0/(1.0D0-cosphi)
5864 etorsi=v1(1,3,3)*fac
5865 etorsi=etorsi+etorsi
5866 etors=etors+etorsi-v1(1,3,3)
5867 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5868 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5871 v1ij=v1(j+1,itori,itori1)
5872 v2ij=v2(j+1,itori,itori1)
5875 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5876 if (energy_dec) etors_ii=etors_ii+
5877 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5878 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5882 v1ij=v1(j,itori,itori1)
5883 v2ij=v2(j,itori,itori1)
5886 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5887 if (energy_dec) etors_ii=etors_ii+
5888 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5889 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5892 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5895 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5896 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5897 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5898 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5899 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5901 ! 6/20/98 - dihedral angle constraints
5904 itori=idih_constr(i)
5907 if (difi.gt.drange(i)) then
5909 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5910 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5911 else if (difi.lt.-drange(i)) then
5913 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5914 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5916 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5917 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5919 ! write (iout,*) 'edihcnstr',edihcnstr
5922 c------------------------------------------------------------------------------
5923 subroutine etor_d(etors_d)
5927 c----------------------------------------------------------------------------
5929 subroutine etor(etors,edihcnstr)
5930 implicit real*8 (a-h,o-z)
5931 include 'DIMENSIONS'
5932 include 'COMMON.VAR'
5933 include 'COMMON.GEO'
5934 include 'COMMON.LOCAL'
5935 include 'COMMON.TORSION'
5936 include 'COMMON.INTERACT'
5937 include 'COMMON.DERIV'
5938 include 'COMMON.CHAIN'
5939 include 'COMMON.NAMES'
5940 include 'COMMON.IOUNITS'
5941 include 'COMMON.FFIELD'
5942 include 'COMMON.TORCNSTR'
5943 include 'COMMON.CONTROL'
5945 C Set lprn=.true. for debugging
5949 do i=iphi_start,iphi_end
5950 C ANY TWO ARE DUMMY ATOMS in row CYCLE
5951 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
5952 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
5953 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
5954 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5955 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5956 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
5957 C For introducing the NH3+ and COO- group please check the etor_d for reference
5960 if (iabs(itype(i)).eq.20) then
5965 itori=itortyp(itype(i-2))
5966 itori1=itortyp(itype(i-1))
5969 C Regular cosine and sine terms
5970 do j=1,nterm(itori,itori1,iblock)
5971 v1ij=v1(j,itori,itori1,iblock)
5972 v2ij=v2(j,itori,itori1,iblock)
5975 etors=etors+v1ij*cosphi+v2ij*sinphi
5976 if (energy_dec) etors_ii=etors_ii+
5977 & v1ij*cosphi+v2ij*sinphi
5978 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5982 C E = SUM ----------------------------------- - v1
5983 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5985 cosphi=dcos(0.5d0*phii)
5986 sinphi=dsin(0.5d0*phii)
5987 do j=1,nlor(itori,itori1,iblock)
5988 vl1ij=vlor1(j,itori,itori1)
5989 vl2ij=vlor2(j,itori,itori1)
5990 vl3ij=vlor3(j,itori,itori1)
5991 pom=vl2ij*cosphi+vl3ij*sinphi
5992 pom1=1.0d0/(pom*pom+1.0d0)
5993 etors=etors+vl1ij*pom1
5994 if (energy_dec) etors_ii=etors_ii+
5997 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5999 C Subtract the constant term
6000 etors=etors-v0(itori,itori1,iblock)
6001 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6002 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6004 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6005 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6006 & (v1(j,itori,itori1,iblock),j=1,6),
6007 & (v2(j,itori,itori1,iblock),j=1,6)
6008 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6009 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6011 ! 6/20/98 - dihedral angle constraints
6013 c do i=1,ndih_constr
6014 do i=idihconstr_start,idihconstr_end
6015 itori=idih_constr(i)
6017 difi=pinorm(phii-phi0(i))
6018 if (difi.gt.drange(i)) then
6020 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6021 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6022 else if (difi.lt.-drange(i)) then
6024 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6025 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6029 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6030 cd & rad2deg*phi0(i), rad2deg*drange(i),
6031 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6033 cd write (iout,*) 'edihcnstr',edihcnstr
6036 c----------------------------------------------------------------------------
6037 subroutine etor_d(etors_d)
6038 C 6/23/01 Compute double torsional energy
6039 implicit real*8 (a-h,o-z)
6040 include 'DIMENSIONS'
6041 include 'COMMON.VAR'
6042 include 'COMMON.GEO'
6043 include 'COMMON.LOCAL'
6044 include 'COMMON.TORSION'
6045 include 'COMMON.INTERACT'
6046 include 'COMMON.DERIV'
6047 include 'COMMON.CHAIN'
6048 include 'COMMON.NAMES'
6049 include 'COMMON.IOUNITS'
6050 include 'COMMON.FFIELD'
6051 include 'COMMON.TORCNSTR'
6053 C Set lprn=.true. for debugging
6057 c write(iout,*) "a tu??"
6058 do i=iphid_start,iphid_end
6059 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6060 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6061 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6062 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6063 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6064 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6065 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6066 & (itype(i+1).eq.ntyp1)) cycle
6067 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6068 itori=itortyp(itype(i-2))
6069 itori1=itortyp(itype(i-1))
6070 itori2=itortyp(itype(i))
6076 if (iabs(itype(i+1)).eq.20) iblock=2
6077 C Iblock=2 Proline type
6078 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6079 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6080 C if (itype(i+1).eq.ntyp1) iblock=3
6081 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6082 C IS or IS NOT need for this
6083 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6084 C is (itype(i-3).eq.ntyp1) ntblock=2
6085 C ntblock is N-terminal blocking group
6087 C Regular cosine and sine terms
6088 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6089 C Example of changes for NH3+ blocking group
6090 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6091 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6092 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6093 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6094 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6095 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6096 cosphi1=dcos(j*phii)
6097 sinphi1=dsin(j*phii)
6098 cosphi2=dcos(j*phii1)
6099 sinphi2=dsin(j*phii1)
6100 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6101 & v2cij*cosphi2+v2sij*sinphi2
6102 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6103 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6105 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6107 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6108 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6109 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6110 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6111 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6112 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6113 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6114 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6115 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6116 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6117 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6118 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6119 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6120 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6123 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6124 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6129 c------------------------------------------------------------------------------
6130 subroutine eback_sc_corr(esccor)
6131 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6132 c conformational states; temporarily implemented as differences
6133 c between UNRES torsional potentials (dependent on three types of
6134 c residues) and the torsional potentials dependent on all 20 types
6135 c of residues computed from AM1 energy surfaces of terminally-blocked
6136 c amino-acid residues.
6137 implicit real*8 (a-h,o-z)
6138 include 'DIMENSIONS'
6139 include 'COMMON.VAR'
6140 include 'COMMON.GEO'
6141 include 'COMMON.LOCAL'
6142 include 'COMMON.TORSION'
6143 include 'COMMON.SCCOR'
6144 include 'COMMON.INTERACT'
6145 include 'COMMON.DERIV'
6146 include 'COMMON.CHAIN'
6147 include 'COMMON.NAMES'
6148 include 'COMMON.IOUNITS'
6149 include 'COMMON.FFIELD'
6150 include 'COMMON.CONTROL'
6152 C Set lprn=.true. for debugging
6155 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6157 do i=itau_start,itau_end
6158 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6160 isccori=isccortyp(itype(i-2))
6161 isccori1=isccortyp(itype(i-1))
6162 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6164 do intertyp=1,3 !intertyp
6165 cc Added 09 May 2012 (Adasko)
6166 cc Intertyp means interaction type of backbone mainchain correlation:
6167 c 1 = SC...Ca...Ca...Ca
6168 c 2 = Ca...Ca...Ca...SC
6169 c 3 = SC...Ca...Ca...SCi
6171 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6172 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6173 & (itype(i-1).eq.ntyp1)))
6174 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6175 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6176 & .or.(itype(i).eq.ntyp1)))
6177 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6178 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6179 & (itype(i-3).eq.ntyp1)))) cycle
6180 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6181 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6183 do j=1,nterm_sccor(isccori,isccori1)
6184 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6185 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6186 cosphi=dcos(j*tauangle(intertyp,i))
6187 sinphi=dsin(j*tauangle(intertyp,i))
6188 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6189 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6191 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6192 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6194 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6195 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6196 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6197 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6198 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6204 c----------------------------------------------------------------------------
6205 subroutine multibody(ecorr)
6206 C This subroutine calculates multi-body contributions to energy following
6207 C the idea of Skolnick et al. If side chains I and J make a contact and
6208 C at the same time side chains I+1 and J+1 make a contact, an extra
6209 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6210 implicit real*8 (a-h,o-z)
6211 include 'DIMENSIONS'
6212 include 'COMMON.IOUNITS'
6213 include 'COMMON.DERIV'
6214 include 'COMMON.INTERACT'
6215 include 'COMMON.CONTACTS'
6216 double precision gx(3),gx1(3)
6219 C Set lprn=.true. for debugging
6223 write (iout,'(a)') 'Contact function values:'
6225 write (iout,'(i2,20(1x,i2,f10.5))')
6226 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6241 num_conti=num_cont(i)
6242 num_conti1=num_cont(i1)
6247 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6248 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6249 cd & ' ishift=',ishift
6250 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6251 C The system gains extra energy.
6252 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6253 endif ! j1==j+-ishift
6262 c------------------------------------------------------------------------------
6263 double precision function esccorr(i,j,k,l,jj,kk)
6264 implicit real*8 (a-h,o-z)
6265 include 'DIMENSIONS'
6266 include 'COMMON.IOUNITS'
6267 include 'COMMON.DERIV'
6268 include 'COMMON.INTERACT'
6269 include 'COMMON.CONTACTS'
6270 double precision gx(3),gx1(3)
6275 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6276 C Calculate the multi-body contribution to energy.
6277 C Calculate multi-body contributions to the gradient.
6278 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6279 cd & k,l,(gacont(m,kk,k),m=1,3)
6281 gx(m) =ekl*gacont(m,jj,i)
6282 gx1(m)=eij*gacont(m,kk,k)
6283 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6284 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6285 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6286 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6290 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6295 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6301 c------------------------------------------------------------------------------
6302 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6303 C This subroutine calculates multi-body contributions to hydrogen-bonding
6304 implicit real*8 (a-h,o-z)
6305 include 'DIMENSIONS'
6306 include 'COMMON.IOUNITS'
6309 parameter (max_cont=maxconts)
6310 parameter (max_dim=26)
6311 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6312 double precision zapas(max_dim,maxconts,max_fg_procs),
6313 & zapas_recv(max_dim,maxconts,max_fg_procs)
6314 common /przechowalnia/ zapas
6315 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6316 & status_array(MPI_STATUS_SIZE,maxconts*2)
6318 include 'COMMON.SETUP'
6319 include 'COMMON.FFIELD'
6320 include 'COMMON.DERIV'
6321 include 'COMMON.INTERACT'
6322 include 'COMMON.CONTACTS'
6323 include 'COMMON.CONTROL'
6324 include 'COMMON.LOCAL'
6325 double precision gx(3),gx1(3),time00
6328 C Set lprn=.true. for debugging
6333 if (nfgtasks.le.1) goto 30
6335 write (iout,'(a)') 'Contact function values before RECEIVE:'
6337 write (iout,'(2i3,50(1x,i2,f5.2))')
6338 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6339 & j=1,num_cont_hb(i))
6343 do i=1,ntask_cont_from
6346 do i=1,ntask_cont_to
6349 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6351 C Make the list of contacts to send to send to other procesors
6352 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6354 do i=iturn3_start,iturn3_end
6355 c write (iout,*) "make contact list turn3",i," num_cont",
6357 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6359 do i=iturn4_start,iturn4_end
6360 c write (iout,*) "make contact list turn4",i," num_cont",
6362 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6366 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6368 do j=1,num_cont_hb(i)
6371 iproc=iint_sent_local(k,jjc,ii)
6372 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6373 if (iproc.gt.0) then
6374 ncont_sent(iproc)=ncont_sent(iproc)+1
6375 nn=ncont_sent(iproc)
6377 zapas(2,nn,iproc)=jjc
6378 zapas(3,nn,iproc)=facont_hb(j,i)
6379 zapas(4,nn,iproc)=ees0p(j,i)
6380 zapas(5,nn,iproc)=ees0m(j,i)
6381 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6382 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6383 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6384 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6385 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6386 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6387 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6388 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6389 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6390 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6391 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6392 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6393 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6394 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6395 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6396 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6397 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6398 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6399 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6400 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6401 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6408 & "Numbers of contacts to be sent to other processors",
6409 & (ncont_sent(i),i=1,ntask_cont_to)
6410 write (iout,*) "Contacts sent"
6411 do ii=1,ntask_cont_to
6413 iproc=itask_cont_to(ii)
6414 write (iout,*) nn," contacts to processor",iproc,
6415 & " of CONT_TO_COMM group"
6417 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6425 CorrelID1=nfgtasks+fg_rank+1
6427 C Receive the numbers of needed contacts from other processors
6428 do ii=1,ntask_cont_from
6429 iproc=itask_cont_from(ii)
6431 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6432 & FG_COMM,req(ireq),IERR)
6434 c write (iout,*) "IRECV ended"
6436 C Send the number of contacts needed by other processors
6437 do ii=1,ntask_cont_to
6438 iproc=itask_cont_to(ii)
6440 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6441 & FG_COMM,req(ireq),IERR)
6443 c write (iout,*) "ISEND ended"
6444 c write (iout,*) "number of requests (nn)",ireq
6447 & call MPI_Waitall(ireq,req,status_array,ierr)
6449 c & "Numbers of contacts to be received from other processors",
6450 c & (ncont_recv(i),i=1,ntask_cont_from)
6454 do ii=1,ntask_cont_from
6455 iproc=itask_cont_from(ii)
6457 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6458 c & " of CONT_TO_COMM group"
6462 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6463 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6464 c write (iout,*) "ireq,req",ireq,req(ireq)
6467 C Send the contacts to processors that need them
6468 do ii=1,ntask_cont_to
6469 iproc=itask_cont_to(ii)
6471 c write (iout,*) nn," contacts to processor",iproc,
6472 c & " of CONT_TO_COMM group"
6475 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6476 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6477 c write (iout,*) "ireq,req",ireq,req(ireq)
6479 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6483 c write (iout,*) "number of requests (contacts)",ireq
6484 c write (iout,*) "req",(req(i),i=1,4)
6487 & call MPI_Waitall(ireq,req,status_array,ierr)
6488 do iii=1,ntask_cont_from
6489 iproc=itask_cont_from(iii)
6492 write (iout,*) "Received",nn," contacts from processor",iproc,
6493 & " of CONT_FROM_COMM group"
6496 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6501 ii=zapas_recv(1,i,iii)
6502 c Flag the received contacts to prevent double-counting
6503 jj=-zapas_recv(2,i,iii)
6504 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6506 nnn=num_cont_hb(ii)+1
6509 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6510 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6511 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6512 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6513 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6514 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6515 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6516 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6517 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6518 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6519 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6520 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6521 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6522 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6523 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6524 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6525 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6526 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6527 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6528 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6529 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6530 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6531 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6532 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6537 write (iout,'(a)') 'Contact function values after receive:'
6539 write (iout,'(2i3,50(1x,i3,f5.2))')
6540 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6541 & j=1,num_cont_hb(i))
6548 write (iout,'(a)') 'Contact function values:'
6550 write (iout,'(2i3,50(1x,i3,f5.2))')
6551 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6552 & j=1,num_cont_hb(i))
6556 C Remove the loop below after debugging !!!
6563 C Calculate the local-electrostatic correlation terms
6564 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6566 num_conti=num_cont_hb(i)
6567 num_conti1=num_cont_hb(i+1)
6574 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6575 c & ' jj=',jj,' kk=',kk
6576 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6577 & .or. j.lt.0 .and. j1.gt.0) .and.
6578 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6579 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6580 C The system gains extra energy.
6581 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6582 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6583 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6585 else if (j1.eq.j) then
6586 C Contacts I-J and I-(J+1) occur simultaneously.
6587 C The system loses extra energy.
6588 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6593 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6594 c & ' jj=',jj,' kk=',kk
6596 C Contacts I-J and (I+1)-J occur simultaneously.
6597 C The system loses extra energy.
6598 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6605 c------------------------------------------------------------------------------
6606 subroutine add_hb_contact(ii,jj,itask)
6607 implicit real*8 (a-h,o-z)
6608 include "DIMENSIONS"
6609 include "COMMON.IOUNITS"
6612 parameter (max_cont=maxconts)
6613 parameter (max_dim=26)
6614 include "COMMON.CONTACTS"
6615 double precision zapas(max_dim,maxconts,max_fg_procs),
6616 & zapas_recv(max_dim,maxconts,max_fg_procs)
6617 common /przechowalnia/ zapas
6618 integer i,j,ii,jj,iproc,itask(4),nn
6619 c write (iout,*) "itask",itask
6622 if (iproc.gt.0) then
6623 do j=1,num_cont_hb(ii)
6625 c write (iout,*) "i",ii," j",jj," jjc",jjc
6627 ncont_sent(iproc)=ncont_sent(iproc)+1
6628 nn=ncont_sent(iproc)
6629 zapas(1,nn,iproc)=ii
6630 zapas(2,nn,iproc)=jjc
6631 zapas(3,nn,iproc)=facont_hb(j,ii)
6632 zapas(4,nn,iproc)=ees0p(j,ii)
6633 zapas(5,nn,iproc)=ees0m(j,ii)
6634 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6635 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6636 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6637 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6638 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6639 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6640 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6641 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6642 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6643 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6644 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6645 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6646 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6647 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6648 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6649 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6650 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6651 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6652 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6653 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6654 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6662 c------------------------------------------------------------------------------
6663 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6665 C This subroutine calculates multi-body contributions to hydrogen-bonding
6666 implicit real*8 (a-h,o-z)
6667 include 'DIMENSIONS'
6668 include 'COMMON.IOUNITS'
6671 parameter (max_cont=maxconts)
6672 parameter (max_dim=70)
6673 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6674 double precision zapas(max_dim,maxconts,max_fg_procs),
6675 & zapas_recv(max_dim,maxconts,max_fg_procs)
6676 common /przechowalnia/ zapas
6677 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6678 & status_array(MPI_STATUS_SIZE,maxconts*2)
6680 include 'COMMON.SETUP'
6681 include 'COMMON.FFIELD'
6682 include 'COMMON.DERIV'
6683 include 'COMMON.LOCAL'
6684 include 'COMMON.INTERACT'
6685 include 'COMMON.CONTACTS'
6686 include 'COMMON.CHAIN'
6687 include 'COMMON.CONTROL'
6688 double precision gx(3),gx1(3)
6689 integer num_cont_hb_old(maxres)
6691 double precision eello4,eello5,eelo6,eello_turn6
6692 external eello4,eello5,eello6,eello_turn6
6693 C Set lprn=.true. for debugging
6698 num_cont_hb_old(i)=num_cont_hb(i)
6702 if (nfgtasks.le.1) goto 30
6704 write (iout,'(a)') 'Contact function values before RECEIVE:'
6706 write (iout,'(2i3,50(1x,i2,f5.2))')
6707 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6708 & j=1,num_cont_hb(i))
6712 do i=1,ntask_cont_from
6715 do i=1,ntask_cont_to
6718 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6720 C Make the list of contacts to send to send to other procesors
6721 do i=iturn3_start,iturn3_end
6722 c write (iout,*) "make contact list turn3",i," num_cont",
6724 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6726 do i=iturn4_start,iturn4_end
6727 c write (iout,*) "make contact list turn4",i," num_cont",
6729 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6733 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6735 do j=1,num_cont_hb(i)
6738 iproc=iint_sent_local(k,jjc,ii)
6739 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6740 if (iproc.ne.0) then
6741 ncont_sent(iproc)=ncont_sent(iproc)+1
6742 nn=ncont_sent(iproc)
6744 zapas(2,nn,iproc)=jjc
6745 zapas(3,nn,iproc)=d_cont(j,i)
6749 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6754 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6762 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6773 & "Numbers of contacts to be sent to other processors",
6774 & (ncont_sent(i),i=1,ntask_cont_to)
6775 write (iout,*) "Contacts sent"
6776 do ii=1,ntask_cont_to
6778 iproc=itask_cont_to(ii)
6779 write (iout,*) nn," contacts to processor",iproc,
6780 & " of CONT_TO_COMM group"
6782 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6790 CorrelID1=nfgtasks+fg_rank+1
6792 C Receive the numbers of needed contacts from other processors
6793 do ii=1,ntask_cont_from
6794 iproc=itask_cont_from(ii)
6796 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6797 & FG_COMM,req(ireq),IERR)
6799 c write (iout,*) "IRECV ended"
6801 C Send the number of contacts needed by other processors
6802 do ii=1,ntask_cont_to
6803 iproc=itask_cont_to(ii)
6805 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6806 & FG_COMM,req(ireq),IERR)
6808 c write (iout,*) "ISEND ended"
6809 c write (iout,*) "number of requests (nn)",ireq
6812 & call MPI_Waitall(ireq,req,status_array,ierr)
6814 c & "Numbers of contacts to be received from other processors",
6815 c & (ncont_recv(i),i=1,ntask_cont_from)
6819 do ii=1,ntask_cont_from
6820 iproc=itask_cont_from(ii)
6822 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6823 c & " of CONT_TO_COMM group"
6827 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6828 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6829 c write (iout,*) "ireq,req",ireq,req(ireq)
6832 C Send the contacts to processors that need them
6833 do ii=1,ntask_cont_to
6834 iproc=itask_cont_to(ii)
6836 c write (iout,*) nn," contacts to processor",iproc,
6837 c & " of CONT_TO_COMM group"
6840 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6841 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6842 c write (iout,*) "ireq,req",ireq,req(ireq)
6844 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6848 c write (iout,*) "number of requests (contacts)",ireq
6849 c write (iout,*) "req",(req(i),i=1,4)
6852 & call MPI_Waitall(ireq,req,status_array,ierr)
6853 do iii=1,ntask_cont_from
6854 iproc=itask_cont_from(iii)
6857 write (iout,*) "Received",nn," contacts from processor",iproc,
6858 & " of CONT_FROM_COMM group"
6861 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6866 ii=zapas_recv(1,i,iii)
6867 c Flag the received contacts to prevent double-counting
6868 jj=-zapas_recv(2,i,iii)
6869 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6871 nnn=num_cont_hb(ii)+1
6874 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6878 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6883 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6891 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6900 write (iout,'(a)') 'Contact function values after receive:'
6902 write (iout,'(2i3,50(1x,i3,5f6.3))')
6903 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6904 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6911 write (iout,'(a)') 'Contact function values:'
6913 write (iout,'(2i3,50(1x,i2,5f6.3))')
6914 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6915 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6921 C Remove the loop below after debugging !!!
6928 C Calculate the dipole-dipole interaction energies
6929 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6930 do i=iatel_s,iatel_e+1
6931 num_conti=num_cont_hb(i)
6940 C Calculate the local-electrostatic correlation terms
6941 c write (iout,*) "gradcorr5 in eello5 before loop"
6943 c write (iout,'(i5,3f10.5)')
6944 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6946 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6947 c write (iout,*) "corr loop i",i
6949 num_conti=num_cont_hb(i)
6950 num_conti1=num_cont_hb(i+1)
6957 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6958 c & ' jj=',jj,' kk=',kk
6959 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6960 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6961 & .or. j.lt.0 .and. j1.gt.0) .and.
6962 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6963 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6964 C The system gains extra energy.
6966 sqd1=dsqrt(d_cont(jj,i))
6967 sqd2=dsqrt(d_cont(kk,i1))
6968 sred_geom = sqd1*sqd2
6969 IF (sred_geom.lt.cutoff_corr) THEN
6970 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6972 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6973 cd & ' jj=',jj,' kk=',kk
6974 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6975 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6977 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6978 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6981 cd write (iout,*) 'sred_geom=',sred_geom,
6982 cd & ' ekont=',ekont,' fprim=',fprimcont,
6983 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6984 cd write (iout,*) "g_contij",g_contij
6985 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6986 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6987 call calc_eello(i,jp,i+1,jp1,jj,kk)
6988 if (wcorr4.gt.0.0d0)
6989 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6990 if (energy_dec.and.wcorr4.gt.0.0d0)
6991 1 write (iout,'(a6,4i5,0pf7.3)')
6992 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6993 c write (iout,*) "gradcorr5 before eello5"
6995 c write (iout,'(i5,3f10.5)')
6996 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6998 if (wcorr5.gt.0.0d0)
6999 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7000 c write (iout,*) "gradcorr5 after eello5"
7002 c write (iout,'(i5,3f10.5)')
7003 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7005 if (energy_dec.and.wcorr5.gt.0.0d0)
7006 1 write (iout,'(a6,4i5,0pf7.3)')
7007 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7008 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7009 cd write(2,*)'ijkl',i,jp,i+1,jp1
7010 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7011 & .or. wturn6.eq.0.0d0))then
7012 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7013 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7014 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7015 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7016 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7017 cd & 'ecorr6=',ecorr6
7018 cd write (iout,'(4e15.5)') sred_geom,
7019 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7020 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7021 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7022 else if (wturn6.gt.0.0d0
7023 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7024 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7025 eturn6=eturn6+eello_turn6(i,jj,kk)
7026 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7027 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7028 cd write (2,*) 'multibody_eello:eturn6',eturn6
7037 num_cont_hb(i)=num_cont_hb_old(i)
7039 c write (iout,*) "gradcorr5 in eello5"
7041 c write (iout,'(i5,3f10.5)')
7042 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7046 c------------------------------------------------------------------------------
7047 subroutine add_hb_contact_eello(ii,jj,itask)
7048 implicit real*8 (a-h,o-z)
7049 include "DIMENSIONS"
7050 include "COMMON.IOUNITS"
7053 parameter (max_cont=maxconts)
7054 parameter (max_dim=70)
7055 include "COMMON.CONTACTS"
7056 double precision zapas(max_dim,maxconts,max_fg_procs),
7057 & zapas_recv(max_dim,maxconts,max_fg_procs)
7058 common /przechowalnia/ zapas
7059 integer i,j,ii,jj,iproc,itask(4),nn
7060 c write (iout,*) "itask",itask
7063 if (iproc.gt.0) then
7064 do j=1,num_cont_hb(ii)
7066 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7068 ncont_sent(iproc)=ncont_sent(iproc)+1
7069 nn=ncont_sent(iproc)
7070 zapas(1,nn,iproc)=ii
7071 zapas(2,nn,iproc)=jjc
7072 zapas(3,nn,iproc)=d_cont(j,ii)
7076 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7081 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7089 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7101 c------------------------------------------------------------------------------
7102 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7103 implicit real*8 (a-h,o-z)
7104 include 'DIMENSIONS'
7105 include 'COMMON.IOUNITS'
7106 include 'COMMON.DERIV'
7107 include 'COMMON.INTERACT'
7108 include 'COMMON.CONTACTS'
7109 double precision gx(3),gx1(3)
7119 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7120 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7121 C Following 4 lines for diagnostics.
7126 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7127 c & 'Contacts ',i,j,
7128 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7129 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7131 C Calculate the multi-body contribution to energy.
7132 c ecorr=ecorr+ekont*ees
7133 C Calculate multi-body contributions to the gradient.
7134 coeffpees0pij=coeffp*ees0pij
7135 coeffmees0mij=coeffm*ees0mij
7136 coeffpees0pkl=coeffp*ees0pkl
7137 coeffmees0mkl=coeffm*ees0mkl
7139 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7140 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7141 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7142 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7143 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7144 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7145 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7146 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7147 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7148 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7149 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7150 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7151 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7152 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7153 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7154 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7155 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7156 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7157 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7158 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7159 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7160 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7161 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7162 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7163 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7168 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7169 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7170 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7171 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7176 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7177 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7178 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7179 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7182 c write (iout,*) "ehbcorr",ekont*ees
7187 C---------------------------------------------------------------------------
7188 subroutine dipole(i,j,jj)
7189 implicit real*8 (a-h,o-z)
7190 include 'DIMENSIONS'
7191 include 'COMMON.IOUNITS'
7192 include 'COMMON.CHAIN'
7193 include 'COMMON.FFIELD'
7194 include 'COMMON.DERIV'
7195 include 'COMMON.INTERACT'
7196 include 'COMMON.CONTACTS'
7197 include 'COMMON.TORSION'
7198 include 'COMMON.VAR'
7199 include 'COMMON.GEO'
7200 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7202 iti1 = itortyp(itype(i+1))
7203 if (j.lt.nres-1) then
7204 itj1 = itortyp(itype(j+1))
7209 dipi(iii,1)=Ub2(iii,i)
7210 dipderi(iii)=Ub2der(iii,i)
7211 dipi(iii,2)=b1(iii,iti1)
7212 dipj(iii,1)=Ub2(iii,j)
7213 dipderj(iii)=Ub2der(iii,j)
7214 dipj(iii,2)=b1(iii,itj1)
7218 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7221 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7228 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7232 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7237 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7238 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7240 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7242 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7244 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7249 C---------------------------------------------------------------------------
7250 subroutine calc_eello(i,j,k,l,jj,kk)
7252 C This subroutine computes matrices and vectors needed to calculate
7253 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7255 implicit real*8 (a-h,o-z)
7256 include 'DIMENSIONS'
7257 include 'COMMON.IOUNITS'
7258 include 'COMMON.CHAIN'
7259 include 'COMMON.DERIV'
7260 include 'COMMON.INTERACT'
7261 include 'COMMON.CONTACTS'
7262 include 'COMMON.TORSION'
7263 include 'COMMON.VAR'
7264 include 'COMMON.GEO'
7265 include 'COMMON.FFIELD'
7266 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7267 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7270 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7271 cd & ' jj=',jj,' kk=',kk
7272 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7273 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7274 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7277 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7278 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7281 call transpose2(aa1(1,1),aa1t(1,1))
7282 call transpose2(aa2(1,1),aa2t(1,1))
7285 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7286 & aa1tder(1,1,lll,kkk))
7287 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7288 & aa2tder(1,1,lll,kkk))
7292 C parallel orientation of the two CA-CA-CA frames.
7294 iti=itortyp(itype(i))
7298 itk1=itortyp(itype(k+1))
7299 itj=itortyp(itype(j))
7300 if (l.lt.nres-1) then
7301 itl1=itortyp(itype(l+1))
7305 C A1 kernel(j+1) A2T
7307 cd write (iout,'(3f10.5,5x,3f10.5)')
7308 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7310 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7311 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7312 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7313 C Following matrices are needed only for 6-th order cumulants
7314 IF (wcorr6.gt.0.0d0) THEN
7315 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7316 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7317 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7318 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7319 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7320 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7321 & ADtEAderx(1,1,1,1,1,1))
7323 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7324 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7325 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7326 & ADtEA1derx(1,1,1,1,1,1))
7328 C End 6-th order cumulants
7331 cd write (2,*) 'In calc_eello6'
7333 cd write (2,*) 'iii=',iii
7335 cd write (2,*) 'kkk=',kkk
7337 cd write (2,'(3(2f10.5),5x)')
7338 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7343 call transpose2(EUgder(1,1,k),auxmat(1,1))
7344 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7345 call transpose2(EUg(1,1,k),auxmat(1,1))
7346 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7347 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7351 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7352 & EAEAderx(1,1,lll,kkk,iii,1))
7356 C A1T kernel(i+1) A2
7357 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7358 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7359 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7360 C Following matrices are needed only for 6-th order cumulants
7361 IF (wcorr6.gt.0.0d0) THEN
7362 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7363 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7364 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7365 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7366 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7367 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7368 & ADtEAderx(1,1,1,1,1,2))
7369 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7370 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7371 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7372 & ADtEA1derx(1,1,1,1,1,2))
7374 C End 6-th order cumulants
7375 call transpose2(EUgder(1,1,l),auxmat(1,1))
7376 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7377 call transpose2(EUg(1,1,l),auxmat(1,1))
7378 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7379 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7383 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7384 & EAEAderx(1,1,lll,kkk,iii,2))
7389 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7390 C They are needed only when the fifth- or the sixth-order cumulants are
7392 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7393 call transpose2(AEA(1,1,1),auxmat(1,1))
7394 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7395 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7396 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7397 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7398 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7399 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7400 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7401 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7402 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7403 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7404 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7405 call transpose2(AEA(1,1,2),auxmat(1,1))
7406 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7407 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7408 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7409 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7410 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7411 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7412 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7413 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7414 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7415 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7416 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7417 C Calculate the Cartesian derivatives of the vectors.
7421 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7422 call matvec2(auxmat(1,1),b1(1,iti),
7423 & AEAb1derx(1,lll,kkk,iii,1,1))
7424 call matvec2(auxmat(1,1),Ub2(1,i),
7425 & AEAb2derx(1,lll,kkk,iii,1,1))
7426 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7427 & AEAb1derx(1,lll,kkk,iii,2,1))
7428 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7429 & AEAb2derx(1,lll,kkk,iii,2,1))
7430 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7431 call matvec2(auxmat(1,1),b1(1,itj),
7432 & AEAb1derx(1,lll,kkk,iii,1,2))
7433 call matvec2(auxmat(1,1),Ub2(1,j),
7434 & AEAb2derx(1,lll,kkk,iii,1,2))
7435 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7436 & AEAb1derx(1,lll,kkk,iii,2,2))
7437 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7438 & AEAb2derx(1,lll,kkk,iii,2,2))
7445 C Antiparallel orientation of the two CA-CA-CA frames.
7447 iti=itortyp(itype(i))
7451 itk1=itortyp(itype(k+1))
7452 itl=itortyp(itype(l))
7453 itj=itortyp(itype(j))
7454 if (j.lt.nres-1) then
7455 itj1=itortyp(itype(j+1))
7459 C A2 kernel(j-1)T A1T
7460 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7461 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7462 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7463 C Following matrices are needed only for 6-th order cumulants
7464 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7465 & j.eq.i+4 .and. l.eq.i+3)) THEN
7466 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7467 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7468 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7469 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7470 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7471 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7472 & ADtEAderx(1,1,1,1,1,1))
7473 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7474 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7475 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7476 & ADtEA1derx(1,1,1,1,1,1))
7478 C End 6-th order cumulants
7479 call transpose2(EUgder(1,1,k),auxmat(1,1))
7480 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7481 call transpose2(EUg(1,1,k),auxmat(1,1))
7482 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7483 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7487 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7488 & EAEAderx(1,1,lll,kkk,iii,1))
7492 C A2T kernel(i+1)T A1
7493 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7494 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7495 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7496 C Following matrices are needed only for 6-th order cumulants
7497 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7498 & j.eq.i+4 .and. l.eq.i+3)) THEN
7499 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7500 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7501 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7502 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7503 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7504 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7505 & ADtEAderx(1,1,1,1,1,2))
7506 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7507 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7508 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7509 & ADtEA1derx(1,1,1,1,1,2))
7511 C End 6-th order cumulants
7512 call transpose2(EUgder(1,1,j),auxmat(1,1))
7513 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7514 call transpose2(EUg(1,1,j),auxmat(1,1))
7515 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7516 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7520 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7521 & EAEAderx(1,1,lll,kkk,iii,2))
7526 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7527 C They are needed only when the fifth- or the sixth-order cumulants are
7529 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7530 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7531 call transpose2(AEA(1,1,1),auxmat(1,1))
7532 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7533 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7534 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7535 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7536 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7537 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7538 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7539 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7540 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7541 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7542 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7543 call transpose2(AEA(1,1,2),auxmat(1,1))
7544 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7545 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7546 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7547 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7548 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7549 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7550 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7551 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7552 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7553 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7554 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7555 C Calculate the Cartesian derivatives of the vectors.
7559 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7560 call matvec2(auxmat(1,1),b1(1,iti),
7561 & AEAb1derx(1,lll,kkk,iii,1,1))
7562 call matvec2(auxmat(1,1),Ub2(1,i),
7563 & AEAb2derx(1,lll,kkk,iii,1,1))
7564 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7565 & AEAb1derx(1,lll,kkk,iii,2,1))
7566 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7567 & AEAb2derx(1,lll,kkk,iii,2,1))
7568 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7569 call matvec2(auxmat(1,1),b1(1,itl),
7570 & AEAb1derx(1,lll,kkk,iii,1,2))
7571 call matvec2(auxmat(1,1),Ub2(1,l),
7572 & AEAb2derx(1,lll,kkk,iii,1,2))
7573 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7574 & AEAb1derx(1,lll,kkk,iii,2,2))
7575 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7576 & AEAb2derx(1,lll,kkk,iii,2,2))
7585 C---------------------------------------------------------------------------
7586 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7587 & KK,KKderg,AKA,AKAderg,AKAderx)
7591 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7592 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7593 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7598 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7600 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7603 cd if (lprn) write (2,*) 'In kernel'
7605 cd if (lprn) write (2,*) 'kkk=',kkk
7607 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7608 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7610 cd write (2,*) 'lll=',lll
7611 cd write (2,*) 'iii=1'
7613 cd write (2,'(3(2f10.5),5x)')
7614 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7617 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7618 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7620 cd write (2,*) 'lll=',lll
7621 cd write (2,*) 'iii=2'
7623 cd write (2,'(3(2f10.5),5x)')
7624 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7631 C---------------------------------------------------------------------------
7632 double precision function eello4(i,j,k,l,jj,kk)
7633 implicit real*8 (a-h,o-z)
7634 include 'DIMENSIONS'
7635 include 'COMMON.IOUNITS'
7636 include 'COMMON.CHAIN'
7637 include 'COMMON.DERIV'
7638 include 'COMMON.INTERACT'
7639 include 'COMMON.CONTACTS'
7640 include 'COMMON.TORSION'
7641 include 'COMMON.VAR'
7642 include 'COMMON.GEO'
7643 double precision pizda(2,2),ggg1(3),ggg2(3)
7644 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7648 cd print *,'eello4:',i,j,k,l,jj,kk
7649 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7650 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7651 cold eij=facont_hb(jj,i)
7652 cold ekl=facont_hb(kk,k)
7654 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7655 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7656 gcorr_loc(k-1)=gcorr_loc(k-1)
7657 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7659 gcorr_loc(l-1)=gcorr_loc(l-1)
7660 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7662 gcorr_loc(j-1)=gcorr_loc(j-1)
7663 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7668 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7669 & -EAEAderx(2,2,lll,kkk,iii,1)
7670 cd derx(lll,kkk,iii)=0.0d0
7674 cd gcorr_loc(l-1)=0.0d0
7675 cd gcorr_loc(j-1)=0.0d0
7676 cd gcorr_loc(k-1)=0.0d0
7678 cd write (iout,*)'Contacts have occurred for peptide groups',
7679 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7680 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7681 if (j.lt.nres-1) then
7688 if (l.lt.nres-1) then
7696 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7697 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7698 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7699 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7700 cgrad ghalf=0.5d0*ggg1(ll)
7701 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7702 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7703 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7704 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7705 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7706 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7707 cgrad ghalf=0.5d0*ggg2(ll)
7708 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7709 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7710 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7711 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7712 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7713 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7717 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7722 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7727 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7732 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7736 cd write (2,*) iii,gcorr_loc(iii)
7739 cd write (2,*) 'ekont',ekont
7740 cd write (iout,*) 'eello4',ekont*eel4
7743 C---------------------------------------------------------------------------
7744 double precision function eello5(i,j,k,l,jj,kk)
7745 implicit real*8 (a-h,o-z)
7746 include 'DIMENSIONS'
7747 include 'COMMON.IOUNITS'
7748 include 'COMMON.CHAIN'
7749 include 'COMMON.DERIV'
7750 include 'COMMON.INTERACT'
7751 include 'COMMON.CONTACTS'
7752 include 'COMMON.TORSION'
7753 include 'COMMON.VAR'
7754 include 'COMMON.GEO'
7755 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7756 double precision ggg1(3),ggg2(3)
7757 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7762 C /l\ / \ \ / \ / \ / C
7763 C / \ / \ \ / \ / \ / C
7764 C j| o |l1 | o | o| o | | o |o C
7765 C \ |/k\| |/ \| / |/ \| |/ \| C
7766 C \i/ \ / \ / / \ / \ C
7768 C (I) (II) (III) (IV) C
7770 C eello5_1 eello5_2 eello5_3 eello5_4 C
7772 C Antiparallel chains C
7775 C /j\ / \ \ / \ / \ / C
7776 C / \ / \ \ / \ / \ / C
7777 C j1| o |l | o | o| o | | o |o C
7778 C \ |/k\| |/ \| / |/ \| |/ \| C
7779 C \i/ \ / \ / / \ / \ C
7781 C (I) (II) (III) (IV) C
7783 C eello5_1 eello5_2 eello5_3 eello5_4 C
7785 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7787 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7788 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7793 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7795 itk=itortyp(itype(k))
7796 itl=itortyp(itype(l))
7797 itj=itortyp(itype(j))
7802 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7803 cd & eel5_3_num,eel5_4_num)
7807 derx(lll,kkk,iii)=0.0d0
7811 cd eij=facont_hb(jj,i)
7812 cd ekl=facont_hb(kk,k)
7814 cd write (iout,*)'Contacts have occurred for peptide groups',
7815 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7817 C Contribution from the graph I.
7818 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7819 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7820 call transpose2(EUg(1,1,k),auxmat(1,1))
7821 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7822 vv(1)=pizda(1,1)-pizda(2,2)
7823 vv(2)=pizda(1,2)+pizda(2,1)
7824 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7825 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7826 C Explicit gradient in virtual-dihedral angles.
7827 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7828 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7829 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7830 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7831 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7832 vv(1)=pizda(1,1)-pizda(2,2)
7833 vv(2)=pizda(1,2)+pizda(2,1)
7834 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7835 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7836 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7837 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7838 vv(1)=pizda(1,1)-pizda(2,2)
7839 vv(2)=pizda(1,2)+pizda(2,1)
7841 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7842 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7843 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7845 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7846 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7847 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7849 C Cartesian gradient
7853 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7855 vv(1)=pizda(1,1)-pizda(2,2)
7856 vv(2)=pizda(1,2)+pizda(2,1)
7857 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7858 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7859 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7865 C Contribution from graph II
7866 call transpose2(EE(1,1,itk),auxmat(1,1))
7867 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7868 vv(1)=pizda(1,1)+pizda(2,2)
7869 vv(2)=pizda(2,1)-pizda(1,2)
7870 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7871 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7872 C Explicit gradient in virtual-dihedral angles.
7873 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7874 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7875 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7876 vv(1)=pizda(1,1)+pizda(2,2)
7877 vv(2)=pizda(2,1)-pizda(1,2)
7879 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7880 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7881 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7883 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7884 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7885 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7887 C Cartesian gradient
7891 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7893 vv(1)=pizda(1,1)+pizda(2,2)
7894 vv(2)=pizda(2,1)-pizda(1,2)
7895 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7896 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7897 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7905 C Parallel orientation
7906 C Contribution from graph III
7907 call transpose2(EUg(1,1,l),auxmat(1,1))
7908 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7909 vv(1)=pizda(1,1)-pizda(2,2)
7910 vv(2)=pizda(1,2)+pizda(2,1)
7911 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7912 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7913 C Explicit gradient in virtual-dihedral angles.
7914 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7915 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7916 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7917 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7918 vv(1)=pizda(1,1)-pizda(2,2)
7919 vv(2)=pizda(1,2)+pizda(2,1)
7920 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7921 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7922 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7923 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7924 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7925 vv(1)=pizda(1,1)-pizda(2,2)
7926 vv(2)=pizda(1,2)+pizda(2,1)
7927 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7928 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7929 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7930 C Cartesian gradient
7934 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7936 vv(1)=pizda(1,1)-pizda(2,2)
7937 vv(2)=pizda(1,2)+pizda(2,1)
7938 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7939 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7940 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7945 C Contribution from graph IV
7947 call transpose2(EE(1,1,itl),auxmat(1,1))
7948 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7949 vv(1)=pizda(1,1)+pizda(2,2)
7950 vv(2)=pizda(2,1)-pizda(1,2)
7951 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7952 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7953 C Explicit gradient in virtual-dihedral angles.
7954 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7955 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7956 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7957 vv(1)=pizda(1,1)+pizda(2,2)
7958 vv(2)=pizda(2,1)-pizda(1,2)
7959 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7960 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7961 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7962 C Cartesian gradient
7966 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
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,2),b1(1,itl))
7972 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7977 C Antiparallel orientation
7978 C Contribution from graph III
7980 call transpose2(EUg(1,1,j),auxmat(1,1))
7981 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7982 vv(1)=pizda(1,1)-pizda(2,2)
7983 vv(2)=pizda(1,2)+pizda(2,1)
7984 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7985 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7986 C Explicit gradient in virtual-dihedral angles.
7987 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7988 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7989 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7990 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7991 vv(1)=pizda(1,1)-pizda(2,2)
7992 vv(2)=pizda(1,2)+pizda(2,1)
7993 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7994 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7995 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7996 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7997 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7998 vv(1)=pizda(1,1)-pizda(2,2)
7999 vv(2)=pizda(1,2)+pizda(2,1)
8000 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8001 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8002 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8003 C Cartesian gradient
8007 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8009 vv(1)=pizda(1,1)-pizda(2,2)
8010 vv(2)=pizda(1,2)+pizda(2,1)
8011 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8012 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8013 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8018 C Contribution from graph IV
8020 call transpose2(EE(1,1,itj),auxmat(1,1))
8021 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8022 vv(1)=pizda(1,1)+pizda(2,2)
8023 vv(2)=pizda(2,1)-pizda(1,2)
8024 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
8025 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8026 C Explicit gradient in virtual-dihedral angles.
8027 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8028 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8029 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8030 vv(1)=pizda(1,1)+pizda(2,2)
8031 vv(2)=pizda(2,1)-pizda(1,2)
8032 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8033 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
8034 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8035 C Cartesian gradient
8039 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8041 vv(1)=pizda(1,1)+pizda(2,2)
8042 vv(2)=pizda(2,1)-pizda(1,2)
8043 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8044 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
8045 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8051 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8052 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8053 cd write (2,*) 'ijkl',i,j,k,l
8054 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8055 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8057 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8058 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8059 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8060 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8061 if (j.lt.nres-1) then
8068 if (l.lt.nres-1) then
8078 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8079 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8080 C summed up outside the subrouine as for the other subroutines
8081 C handling long-range interactions. The old code is commented out
8082 C with "cgrad" to keep track of changes.
8084 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8085 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8086 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8087 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8088 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8089 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8090 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8091 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8092 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8093 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8095 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8096 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8097 cgrad ghalf=0.5d0*ggg1(ll)
8099 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8100 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8101 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8102 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8103 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8104 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8105 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8106 cgrad ghalf=0.5d0*ggg2(ll)
8108 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8109 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8110 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8111 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8112 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8113 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8118 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8119 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8124 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8125 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8131 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8136 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8140 cd write (2,*) iii,g_corr5_loc(iii)
8143 cd write (2,*) 'ekont',ekont
8144 cd write (iout,*) 'eello5',ekont*eel5
8147 c--------------------------------------------------------------------------
8148 double precision function eello6(i,j,k,l,jj,kk)
8149 implicit real*8 (a-h,o-z)
8150 include 'DIMENSIONS'
8151 include 'COMMON.IOUNITS'
8152 include 'COMMON.CHAIN'
8153 include 'COMMON.DERIV'
8154 include 'COMMON.INTERACT'
8155 include 'COMMON.CONTACTS'
8156 include 'COMMON.TORSION'
8157 include 'COMMON.VAR'
8158 include 'COMMON.GEO'
8159 include 'COMMON.FFIELD'
8160 double precision ggg1(3),ggg2(3)
8161 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8166 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8174 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8175 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8179 derx(lll,kkk,iii)=0.0d0
8183 cd eij=facont_hb(jj,i)
8184 cd ekl=facont_hb(kk,k)
8190 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8191 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8192 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8193 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8194 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8195 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8197 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8198 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8199 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8200 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8201 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8202 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8206 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8208 C If turn contributions are considered, they will be handled separately.
8209 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8210 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8211 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8212 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8213 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8214 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8215 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8217 if (j.lt.nres-1) then
8224 if (l.lt.nres-1) then
8232 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8233 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8234 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8235 cgrad ghalf=0.5d0*ggg1(ll)
8237 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8238 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8239 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8240 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8241 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8242 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8243 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8244 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8245 cgrad ghalf=0.5d0*ggg2(ll)
8246 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8248 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8249 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8250 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8251 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8252 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8253 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8258 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8259 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8264 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8265 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8271 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8276 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8280 cd write (2,*) iii,g_corr6_loc(iii)
8283 cd write (2,*) 'ekont',ekont
8284 cd write (iout,*) 'eello6',ekont*eel6
8287 c--------------------------------------------------------------------------
8288 double precision function eello6_graph1(i,j,k,l,imat,swap)
8289 implicit real*8 (a-h,o-z)
8290 include 'DIMENSIONS'
8291 include 'COMMON.IOUNITS'
8292 include 'COMMON.CHAIN'
8293 include 'COMMON.DERIV'
8294 include 'COMMON.INTERACT'
8295 include 'COMMON.CONTACTS'
8296 include 'COMMON.TORSION'
8297 include 'COMMON.VAR'
8298 include 'COMMON.GEO'
8299 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8303 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8305 C Parallel Antiparallel C
8311 C \ j|/k\| / \ |/k\|l / C
8316 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8317 itk=itortyp(itype(k))
8318 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8319 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8320 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8321 call transpose2(EUgC(1,1,k),auxmat(1,1))
8322 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8323 vv1(1)=pizda1(1,1)-pizda1(2,2)
8324 vv1(2)=pizda1(1,2)+pizda1(2,1)
8325 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8326 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8327 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8328 s5=scalar2(vv(1),Dtobr2(1,i))
8329 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8330 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8331 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8332 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8333 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8334 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8335 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8336 & +scalar2(vv(1),Dtobr2der(1,i)))
8337 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8338 vv1(1)=pizda1(1,1)-pizda1(2,2)
8339 vv1(2)=pizda1(1,2)+pizda1(2,1)
8340 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8341 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8343 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8344 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8345 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8346 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8347 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8349 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8350 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8351 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8352 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8353 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8355 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8356 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8357 vv1(1)=pizda1(1,1)-pizda1(2,2)
8358 vv1(2)=pizda1(1,2)+pizda1(2,1)
8359 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8360 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8361 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8362 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8371 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8372 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8373 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8374 call transpose2(EUgC(1,1,k),auxmat(1,1))
8375 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8377 vv1(1)=pizda1(1,1)-pizda1(2,2)
8378 vv1(2)=pizda1(1,2)+pizda1(2,1)
8379 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8380 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8381 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8382 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8383 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8384 s5=scalar2(vv(1),Dtobr2(1,i))
8385 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8391 c----------------------------------------------------------------------------
8392 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8393 implicit real*8 (a-h,o-z)
8394 include 'DIMENSIONS'
8395 include 'COMMON.IOUNITS'
8396 include 'COMMON.CHAIN'
8397 include 'COMMON.DERIV'
8398 include 'COMMON.INTERACT'
8399 include 'COMMON.CONTACTS'
8400 include 'COMMON.TORSION'
8401 include 'COMMON.VAR'
8402 include 'COMMON.GEO'
8404 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8405 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8408 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8410 C Parallel Antiparallel C
8416 C \ j|/k\| \ |/k\|l C
8421 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8422 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8423 C AL 7/4/01 s1 would occur in the sixth-order moment,
8424 C but not in a cluster cumulant
8426 s1=dip(1,jj,i)*dip(1,kk,k)
8428 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8429 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8430 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8431 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8432 call transpose2(EUg(1,1,k),auxmat(1,1))
8433 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8434 vv(1)=pizda(1,1)-pizda(2,2)
8435 vv(2)=pizda(1,2)+pizda(2,1)
8436 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8437 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8439 eello6_graph2=-(s1+s2+s3+s4)
8441 eello6_graph2=-(s2+s3+s4)
8444 C Derivatives in gamma(i-1)
8447 s1=dipderg(1,jj,i)*dip(1,kk,k)
8449 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8450 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8451 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8452 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8454 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8456 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8458 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8460 C Derivatives in gamma(k-1)
8462 s1=dip(1,jj,i)*dipderg(1,kk,k)
8464 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8465 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8466 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8467 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8468 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8469 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8470 vv(1)=pizda(1,1)-pizda(2,2)
8471 vv(2)=pizda(1,2)+pizda(2,1)
8472 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8474 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8476 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8478 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8479 C Derivatives in gamma(j-1) or gamma(l-1)
8482 s1=dipderg(3,jj,i)*dip(1,kk,k)
8484 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8485 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8486 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8487 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8488 vv(1)=pizda(1,1)-pizda(2,2)
8489 vv(2)=pizda(1,2)+pizda(2,1)
8490 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8493 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8495 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8498 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8499 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8501 C Derivatives in gamma(l-1) or gamma(j-1)
8504 s1=dip(1,jj,i)*dipderg(3,kk,k)
8506 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8507 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8508 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8509 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8510 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8511 vv(1)=pizda(1,1)-pizda(2,2)
8512 vv(2)=pizda(1,2)+pizda(2,1)
8513 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8516 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8518 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8521 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8522 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8524 C Cartesian derivatives.
8526 write (2,*) 'In eello6_graph2'
8528 write (2,*) 'iii=',iii
8530 write (2,*) 'kkk=',kkk
8532 write (2,'(3(2f10.5),5x)')
8533 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8543 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8545 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8548 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8550 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8551 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8553 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8554 call transpose2(EUg(1,1,k),auxmat(1,1))
8555 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8557 vv(1)=pizda(1,1)-pizda(2,2)
8558 vv(2)=pizda(1,2)+pizda(2,1)
8559 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8560 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8562 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8564 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8567 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8569 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8576 c----------------------------------------------------------------------------
8577 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8578 implicit real*8 (a-h,o-z)
8579 include 'DIMENSIONS'
8580 include 'COMMON.IOUNITS'
8581 include 'COMMON.CHAIN'
8582 include 'COMMON.DERIV'
8583 include 'COMMON.INTERACT'
8584 include 'COMMON.CONTACTS'
8585 include 'COMMON.TORSION'
8586 include 'COMMON.VAR'
8587 include 'COMMON.GEO'
8588 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8590 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8592 C Parallel Antiparallel C
8598 C j|/k\| / |/k\|l / C
8603 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8605 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8606 C energy moment and not to the cluster cumulant.
8607 iti=itortyp(itype(i))
8608 if (j.lt.nres-1) then
8609 itj1=itortyp(itype(j+1))
8613 itk=itortyp(itype(k))
8614 itk1=itortyp(itype(k+1))
8615 if (l.lt.nres-1) then
8616 itl1=itortyp(itype(l+1))
8621 s1=dip(4,jj,i)*dip(4,kk,k)
8623 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8624 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8625 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8626 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8627 call transpose2(EE(1,1,itk),auxmat(1,1))
8628 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8629 vv(1)=pizda(1,1)+pizda(2,2)
8630 vv(2)=pizda(2,1)-pizda(1,2)
8631 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8632 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8633 cd & "sum",-(s2+s3+s4)
8635 eello6_graph3=-(s1+s2+s3+s4)
8637 eello6_graph3=-(s2+s3+s4)
8640 C Derivatives in gamma(k-1)
8641 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8642 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8643 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8644 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8645 C Derivatives in gamma(l-1)
8646 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8647 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8648 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8649 vv(1)=pizda(1,1)+pizda(2,2)
8650 vv(2)=pizda(2,1)-pizda(1,2)
8651 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8652 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8653 C Cartesian derivatives.
8659 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8661 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8664 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8666 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8667 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8669 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8670 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8672 vv(1)=pizda(1,1)+pizda(2,2)
8673 vv(2)=pizda(2,1)-pizda(1,2)
8674 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8676 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8678 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8681 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8683 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8685 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8691 c----------------------------------------------------------------------------
8692 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8693 implicit real*8 (a-h,o-z)
8694 include 'DIMENSIONS'
8695 include 'COMMON.IOUNITS'
8696 include 'COMMON.CHAIN'
8697 include 'COMMON.DERIV'
8698 include 'COMMON.INTERACT'
8699 include 'COMMON.CONTACTS'
8700 include 'COMMON.TORSION'
8701 include 'COMMON.VAR'
8702 include 'COMMON.GEO'
8703 include 'COMMON.FFIELD'
8704 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8705 & auxvec1(2),auxmat1(2,2)
8707 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8709 C Parallel Antiparallel C
8715 C \ j|/k\| \ |/k\|l C
8720 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8722 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8723 C energy moment and not to the cluster cumulant.
8724 cd write (2,*) 'eello_graph4: wturn6',wturn6
8725 iti=itortyp(itype(i))
8726 itj=itortyp(itype(j))
8727 if (j.lt.nres-1) then
8728 itj1=itortyp(itype(j+1))
8732 itk=itortyp(itype(k))
8733 if (k.lt.nres-1) then
8734 itk1=itortyp(itype(k+1))
8738 itl=itortyp(itype(l))
8739 if (l.lt.nres-1) then
8740 itl1=itortyp(itype(l+1))
8744 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8745 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8746 cd & ' itl',itl,' itl1',itl1
8749 s1=dip(3,jj,i)*dip(3,kk,k)
8751 s1=dip(2,jj,j)*dip(2,kk,l)
8754 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8755 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8757 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8758 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8760 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8761 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8763 call transpose2(EUg(1,1,k),auxmat(1,1))
8764 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8765 vv(1)=pizda(1,1)-pizda(2,2)
8766 vv(2)=pizda(2,1)+pizda(1,2)
8767 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8768 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8770 eello6_graph4=-(s1+s2+s3+s4)
8772 eello6_graph4=-(s2+s3+s4)
8774 C Derivatives in gamma(i-1)
8778 s1=dipderg(2,jj,i)*dip(3,kk,k)
8780 s1=dipderg(4,jj,j)*dip(2,kk,l)
8783 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8785 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8786 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8788 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8789 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8791 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8792 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8793 cd write (2,*) 'turn6 derivatives'
8795 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8797 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8801 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8803 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8807 C Derivatives in gamma(k-1)
8810 s1=dip(3,jj,i)*dipderg(2,kk,k)
8812 s1=dip(2,jj,j)*dipderg(4,kk,l)
8815 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8816 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8818 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8819 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8821 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8822 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8824 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8825 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8826 vv(1)=pizda(1,1)-pizda(2,2)
8827 vv(2)=pizda(2,1)+pizda(1,2)
8828 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8829 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8831 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8833 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8837 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8839 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8842 C Derivatives in gamma(j-1) or gamma(l-1)
8843 if (l.eq.j+1 .and. l.gt.1) then
8844 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8845 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8846 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8847 vv(1)=pizda(1,1)-pizda(2,2)
8848 vv(2)=pizda(2,1)+pizda(1,2)
8849 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8850 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8851 else if (j.gt.1) then
8852 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8853 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8854 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8855 vv(1)=pizda(1,1)-pizda(2,2)
8856 vv(2)=pizda(2,1)+pizda(1,2)
8857 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8858 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8859 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8861 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8864 C Cartesian derivatives.
8871 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8873 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8877 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8879 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8883 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8885 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8887 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8888 & b1(1,itj1),auxvec(1))
8889 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8891 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8892 & b1(1,itl1),auxvec(1))
8893 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8895 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8897 vv(1)=pizda(1,1)-pizda(2,2)
8898 vv(2)=pizda(2,1)+pizda(1,2)
8899 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8901 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8903 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8906 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8909 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8912 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8914 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8916 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8920 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8922 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8925 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8927 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8935 c----------------------------------------------------------------------------
8936 double precision function eello_turn6(i,jj,kk)
8937 implicit real*8 (a-h,o-z)
8938 include 'DIMENSIONS'
8939 include 'COMMON.IOUNITS'
8940 include 'COMMON.CHAIN'
8941 include 'COMMON.DERIV'
8942 include 'COMMON.INTERACT'
8943 include 'COMMON.CONTACTS'
8944 include 'COMMON.TORSION'
8945 include 'COMMON.VAR'
8946 include 'COMMON.GEO'
8947 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8948 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8950 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8951 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8952 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8953 C the respective energy moment and not to the cluster cumulant.
8962 iti=itortyp(itype(i))
8963 itk=itortyp(itype(k))
8964 itk1=itortyp(itype(k+1))
8965 itl=itortyp(itype(l))
8966 itj=itortyp(itype(j))
8967 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8968 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8969 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8974 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8976 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8980 derx_turn(lll,kkk,iii)=0.0d0
8987 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8989 cd write (2,*) 'eello6_5',eello6_5
8991 call transpose2(AEA(1,1,1),auxmat(1,1))
8992 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8993 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8994 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8996 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8997 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8998 s2 = scalar2(b1(1,itk),vtemp1(1))
9000 call transpose2(AEA(1,1,2),atemp(1,1))
9001 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9002 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9003 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9005 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9006 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9007 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9009 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9010 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9011 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9012 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9013 ss13 = scalar2(b1(1,itk),vtemp4(1))
9014 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9016 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9022 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9023 C Derivatives in gamma(i+2)
9027 call transpose2(AEA(1,1,1),auxmatd(1,1))
9028 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9029 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9030 call transpose2(AEAderg(1,1,2),atempd(1,1))
9031 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9032 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9034 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9035 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9036 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9042 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9043 C Derivatives in gamma(i+3)
9045 call transpose2(AEA(1,1,1),auxmatd(1,1))
9046 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9047 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9048 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9050 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9051 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9052 s2d = scalar2(b1(1,itk),vtemp1d(1))
9054 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9055 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9057 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9059 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9060 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9061 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9069 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9070 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9072 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9073 & -0.5d0*ekont*(s2d+s12d)
9075 C Derivatives in gamma(i+4)
9076 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9077 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9078 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9080 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9081 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9082 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9090 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9092 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9094 C Derivatives in gamma(i+5)
9096 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9097 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9098 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9100 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9101 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9102 s2d = scalar2(b1(1,itk),vtemp1d(1))
9104 call transpose2(AEA(1,1,2),atempd(1,1))
9105 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9106 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9108 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9109 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9111 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9112 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9113 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9121 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9122 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9124 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9125 & -0.5d0*ekont*(s2d+s12d)
9127 C Cartesian derivatives
9132 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9133 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9134 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9136 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9137 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9139 s2d = scalar2(b1(1,itk),vtemp1d(1))
9141 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9142 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9143 s8d = -(atempd(1,1)+atempd(2,2))*
9144 & scalar2(cc(1,1,itl),vtemp2(1))
9146 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9148 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9149 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9156 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9159 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9163 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9164 & - 0.5d0*(s8d+s12d)
9166 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9175 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9177 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9178 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9179 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9180 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9181 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9183 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9184 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9185 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9189 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9190 cd & 16*eel_turn6_num
9192 if (j.lt.nres-1) then
9199 if (l.lt.nres-1) then
9207 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9208 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9209 cgrad ghalf=0.5d0*ggg1(ll)
9211 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9212 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9213 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9214 & +ekont*derx_turn(ll,2,1)
9215 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9216 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9217 & +ekont*derx_turn(ll,4,1)
9218 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9219 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9220 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9221 cgrad ghalf=0.5d0*ggg2(ll)
9223 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9224 & +ekont*derx_turn(ll,2,2)
9225 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9226 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9227 & +ekont*derx_turn(ll,4,2)
9228 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9229 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9230 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9235 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9240 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9246 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9251 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9255 cd write (2,*) iii,g_corr6_loc(iii)
9257 eello_turn6=ekont*eel_turn6
9258 cd write (2,*) 'ekont',ekont
9259 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9263 C-----------------------------------------------------------------------------
9264 double precision function scalar(u,v)
9265 !DIR$ INLINEALWAYS scalar
9267 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9270 double precision u(3),v(3)
9271 cd double precision sc
9279 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9282 crc-------------------------------------------------
9283 SUBROUTINE MATVEC2(A1,V1,V2)
9284 !DIR$ INLINEALWAYS MATVEC2
9286 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9288 implicit real*8 (a-h,o-z)
9289 include 'DIMENSIONS'
9290 DIMENSION A1(2,2),V1(2),V2(2)
9294 c 3 VI=VI+A1(I,K)*V1(K)
9298 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9299 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9304 C---------------------------------------
9305 SUBROUTINE MATMAT2(A1,A2,A3)
9307 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9309 implicit real*8 (a-h,o-z)
9310 include 'DIMENSIONS'
9311 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9312 c DIMENSION AI3(2,2)
9316 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9322 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9323 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9324 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9325 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9333 c-------------------------------------------------------------------------
9334 double precision function scalar2(u,v)
9335 !DIR$ INLINEALWAYS scalar2
9337 double precision u(2),v(2)
9340 scalar2=u(1)*v(1)+u(2)*v(2)
9344 C-----------------------------------------------------------------------------
9346 subroutine transpose2(a,at)
9347 !DIR$ INLINEALWAYS transpose2
9349 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9352 double precision a(2,2),at(2,2)
9359 c--------------------------------------------------------------------------
9360 subroutine transpose(n,a,at)
9363 double precision a(n,n),at(n,n)
9371 C---------------------------------------------------------------------------
9372 subroutine prodmat3(a1,a2,kk,transp,prod)
9373 !DIR$ INLINEALWAYS prodmat3
9375 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9379 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9381 crc double precision auxmat(2,2),prod_(2,2)
9384 crc call transpose2(kk(1,1),auxmat(1,1))
9385 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9386 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9388 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9389 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9390 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9391 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9392 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9393 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9394 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9395 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9398 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9399 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9401 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9402 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9403 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9404 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9405 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9406 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9407 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9408 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9411 c call transpose2(a2(1,1),a2t(1,1))
9414 crc print *,((prod_(i,j),i=1,2),j=1,2)
9415 crc print *,((prod(i,j),i=1,2),j=1,2)