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 c & .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
2925 dx_normi=dc_norm(1,i)
2926 dy_normi=dc_norm(2,i)
2927 dz_normi=dc_norm(3,i)
2928 xmedi=c(1,i)+0.5d0*dxi
2929 ymedi=c(2,i)+0.5d0*dyi
2930 zmedi=c(3,i)+0.5d0*dzi
2931 C Return atom into box, boxxsize is size of box in x dimension
2933 if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2934 if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2935 C Condition for being inside the proper box
2936 if ((xmedi.gt.((0.5d0)*boxxsize)).or.
2937 & (xmedi.lt.((-0.5d0)*boxxsize))) then
2941 if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
2942 if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2943 C Condition for being inside the proper box
2944 if ((ymedi.gt.((0.5d0)*boxysize)).or.
2945 & (ymedi.lt.((-0.5d0)*boxysize))) then
2949 if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2950 if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2951 C Condition for being inside the proper box
2952 if ((zmedi.gt.((0.5d0)*boxzsize)).or.
2953 & (zmedi.lt.((-0.5d0)*boxzsize))) then
2957 num_conti=num_cont_hb(i)
2958 call eelecij(i,i+3,ees,evdw1,eel_loc)
2959 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2960 & call eturn4(i,eello_turn4)
2961 num_cont_hb(i)=num_conti
2963 C Loop over all neighbouring boxes
2968 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2970 do i=iatel_s,iatel_e
2971 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2972 & .or. itype(i+2).eq.ntyp1
2977 dx_normi=dc_norm(1,i)
2978 dy_normi=dc_norm(2,i)
2979 dz_normi=dc_norm(3,i)
2980 xmedi=c(1,i)+0.5d0*dxi
2981 ymedi=c(2,i)+0.5d0*dyi
2982 zmedi=c(3,i)+0.5d0*dzi
2983 C Return atom into box, boxxsize is size of box in x dimension
2985 if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2986 if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2987 C Condition for being inside the proper box
2988 if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
2989 & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
2993 if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
2994 if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2995 C Condition for being inside the proper box
2996 if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
2997 & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3001 if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3002 if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3003 C Condition for being inside the proper box
3004 if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3005 & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3009 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3010 num_conti=num_cont_hb(i)
3011 do j=ielstart(i),ielend(i)
3012 c write (iout,*) i,j,itype(i),itype(j)
3013 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3014 & .or.itype(j+2).eq.ntyp1
3016 call eelecij(i,j,ees,evdw1,eel_loc)
3018 num_cont_hb(i)=num_conti
3024 c write (iout,*) "Number of loop steps in EELEC:",ind
3026 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3027 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3029 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3030 ccc eel_loc=eel_loc+eello_turn3
3031 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3034 C-------------------------------------------------------------------------------
3035 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3036 implicit real*8 (a-h,o-z)
3037 include 'DIMENSIONS'
3041 include 'COMMON.CONTROL'
3042 include 'COMMON.IOUNITS'
3043 include 'COMMON.GEO'
3044 include 'COMMON.VAR'
3045 include 'COMMON.LOCAL'
3046 include 'COMMON.CHAIN'
3047 include 'COMMON.DERIV'
3048 include 'COMMON.INTERACT'
3049 include 'COMMON.CONTACTS'
3050 include 'COMMON.TORSION'
3051 include 'COMMON.VECTORS'
3052 include 'COMMON.FFIELD'
3053 include 'COMMON.TIME1'
3054 include 'COMMON.SPLITELE'
3055 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3056 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3057 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3058 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3059 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3060 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3062 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3064 double precision scal_el /1.0d0/
3066 double precision scal_el /0.5d0/
3069 C 13-go grudnia roku pamietnego...
3070 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3071 & 0.0d0,1.0d0,0.0d0,
3072 & 0.0d0,0.0d0,1.0d0/
3073 c time00=MPI_Wtime()
3074 cd write (iout,*) "eelecij",i,j
3078 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3079 aaa=app(iteli,itelj)
3080 bbb=bpp(iteli,itelj)
3081 ael6i=ael6(iteli,itelj)
3082 ael3i=ael3(iteli,itelj)
3086 dx_normj=dc_norm(1,j)
3087 dy_normj=dc_norm(2,j)
3088 dz_normj=dc_norm(3,j)
3089 C xj=c(1,j)+0.5D0*dxj-xmedi
3090 C yj=c(2,j)+0.5D0*dyj-ymedi
3091 C zj=c(3,j)+0.5D0*dzj-zmedi
3095 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3097 if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3098 if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3099 C Condition for being inside the proper box
3100 if ((xj.gt.((0.5d0)*boxxsize)).or.
3101 & (xj.lt.((-0.5d0)*boxxsize))) then
3105 if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3106 if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3107 C Condition for being inside the proper box
3108 if ((yj.gt.((0.5d0)*boxysize)).or.
3109 & (yj.lt.((-0.5d0)*boxysize))) then
3113 if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3114 if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3115 C Condition for being inside the proper box
3116 if ((zj.gt.((0.5d0)*boxzsize)).or.
3117 & (zj.lt.((-0.5d0)*boxzsize))) then
3120 C endif !endPBC condintion
3124 rij=xj*xj+yj*yj+zj*zj
3126 sss=sscale(sqrt(rij))
3127 sssgrad=sscagrad(sqrt(rij))
3128 c if (sss.gt.0.0d0) then
3134 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3135 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3136 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3137 fac=cosa-3.0D0*cosb*cosg
3139 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3140 if (j.eq.i+2) ev1=scal_el*ev1
3145 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3149 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3150 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3152 evdw1=evdw1+evdwij*sss
3153 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3154 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3155 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3156 cd & xmedi,ymedi,zmedi,xj,yj,zj
3158 if (energy_dec) then
3159 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3161 &,iteli,itelj,aaa,evdw1
3162 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3166 C Calculate contributions to the Cartesian gradient.
3169 facvdw=-6*rrmij*(ev1+evdwij)*sss
3170 facel=-3*rrmij*(el1+eesij)
3176 * Radial derivatives. First process both termini of the fragment (i,j)
3182 c ghalf=0.5D0*ggg(k)
3183 c gelc(k,i)=gelc(k,i)+ghalf
3184 c gelc(k,j)=gelc(k,j)+ghalf
3186 c 9/28/08 AL Gradient compotents will be summed only at the end
3188 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3189 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3192 * Loop over residues i+1 thru j-1.
3196 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3199 if (sss.gt.0.0) then
3200 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3201 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3202 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3209 c ghalf=0.5D0*ggg(k)
3210 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3211 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3213 c 9/28/08 AL Gradient compotents will be summed only at the end
3215 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3216 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3219 * Loop over residues i+1 thru j-1.
3223 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3228 facvdw=(ev1+evdwij)*sss
3231 fac=-3*rrmij*(facvdw+facvdw+facel)
3236 * Radial derivatives. First process both termini of the fragment (i,j)
3242 c ghalf=0.5D0*ggg(k)
3243 c gelc(k,i)=gelc(k,i)+ghalf
3244 c gelc(k,j)=gelc(k,j)+ghalf
3246 c 9/28/08 AL Gradient compotents will be summed only at the end
3248 gelc_long(k,j)=gelc(k,j)+ggg(k)
3249 gelc_long(k,i)=gelc(k,i)-ggg(k)
3252 * Loop over residues i+1 thru j-1.
3256 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3259 c 9/28/08 AL Gradient compotents will be summed only at the end
3260 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3261 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3262 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3264 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3265 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3271 ecosa=2.0D0*fac3*fac1+fac4
3274 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3275 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3277 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3278 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3280 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3281 cd & (dcosg(k),k=1,3)
3283 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3286 c ghalf=0.5D0*ggg(k)
3287 c gelc(k,i)=gelc(k,i)+ghalf
3288 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3289 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3290 c gelc(k,j)=gelc(k,j)+ghalf
3291 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3292 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3296 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3301 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3302 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3304 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3305 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3306 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3307 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3311 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3312 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3313 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3315 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3316 C energy of a peptide unit is assumed in the form of a second-order
3317 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3318 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3319 C are computed for EVERY pair of non-contiguous peptide groups.
3321 if (j.lt.nres-1) then
3332 muij(kkk)=mu(k,i)*mu(l,j)
3335 cd write (iout,*) 'EELEC: i',i,' j',j
3336 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3337 cd write(iout,*) 'muij',muij
3338 ury=scalar(uy(1,i),erij)
3339 urz=scalar(uz(1,i),erij)
3340 vry=scalar(uy(1,j),erij)
3341 vrz=scalar(uz(1,j),erij)
3342 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3343 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3344 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3345 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3346 fac=dsqrt(-ael6i)*r3ij
3351 cd write (iout,'(4i5,4f10.5)')
3352 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3353 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3354 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3355 cd & uy(:,j),uz(:,j)
3356 cd write (iout,'(4f10.5)')
3357 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3358 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3359 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3360 cd write (iout,'(9f10.5/)')
3361 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3362 C Derivatives of the elements of A in virtual-bond vectors
3363 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3365 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3366 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3367 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3368 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3369 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3370 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3371 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3372 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3373 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3374 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3375 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3376 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3378 C Compute radial contributions to the gradient
3396 C Add the contributions coming from er
3399 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3400 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3401 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3402 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3405 C Derivatives in DC(i)
3406 cgrad ghalf1=0.5d0*agg(k,1)
3407 cgrad ghalf2=0.5d0*agg(k,2)
3408 cgrad ghalf3=0.5d0*agg(k,3)
3409 cgrad ghalf4=0.5d0*agg(k,4)
3410 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3411 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3412 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3413 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3414 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3415 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3416 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3417 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3418 C Derivatives in DC(i+1)
3419 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3420 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3421 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3422 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3423 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3424 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3425 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3426 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3427 C Derivatives in DC(j)
3428 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3429 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3430 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3431 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3432 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3433 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3434 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3435 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3436 C Derivatives in DC(j+1) or DC(nres-1)
3437 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3438 & -3.0d0*vryg(k,3)*ury)
3439 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3440 & -3.0d0*vrzg(k,3)*ury)
3441 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3442 & -3.0d0*vryg(k,3)*urz)
3443 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3444 & -3.0d0*vrzg(k,3)*urz)
3445 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3447 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3460 aggi(k,l)=-aggi(k,l)
3461 aggi1(k,l)=-aggi1(k,l)
3462 aggj(k,l)=-aggj(k,l)
3463 aggj1(k,l)=-aggj1(k,l)
3466 if (j.lt.nres-1) then
3472 aggi(k,l)=-aggi(k,l)
3473 aggi1(k,l)=-aggi1(k,l)
3474 aggj(k,l)=-aggj(k,l)
3475 aggj1(k,l)=-aggj1(k,l)
3486 aggi(k,l)=-aggi(k,l)
3487 aggi1(k,l)=-aggi1(k,l)
3488 aggj(k,l)=-aggj(k,l)
3489 aggj1(k,l)=-aggj1(k,l)
3494 IF (wel_loc.gt.0.0d0) THEN
3495 C Contribution to the local-electrostatic energy coming from the i-j pair
3496 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3498 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3499 c & ' eel_loc_ij',eel_loc_ij
3501 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3502 & 'eelloc',i,j,eel_loc_ij
3503 c if (eel_loc_ij.ne.0)
3504 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3505 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3507 eel_loc=eel_loc+eel_loc_ij
3508 C Partial derivatives in virtual-bond dihedral angles gamma
3510 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3511 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3512 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3513 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3514 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3515 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3516 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3518 ggg(l)=agg(l,1)*muij(1)+
3519 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3520 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3521 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3522 cgrad ghalf=0.5d0*ggg(l)
3523 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3524 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3528 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3531 C Remaining derivatives of eello
3533 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3534 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3535 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3536 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3537 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3538 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3539 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3540 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3543 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3544 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3545 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3546 & .and. num_conti.le.maxconts) then
3547 c write (iout,*) i,j," entered corr"
3549 C Calculate the contact function. The ith column of the array JCONT will
3550 C contain the numbers of atoms that make contacts with the atom I (of numbers
3551 C greater than I). The arrays FACONT and GACONT will contain the values of
3552 C the contact function and its derivative.
3553 c r0ij=1.02D0*rpp(iteli,itelj)
3554 c r0ij=1.11D0*rpp(iteli,itelj)
3555 r0ij=2.20D0*rpp(iteli,itelj)
3556 c r0ij=1.55D0*rpp(iteli,itelj)
3557 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3558 if (fcont.gt.0.0D0) then
3559 num_conti=num_conti+1
3560 if (num_conti.gt.maxconts) then
3561 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3562 & ' will skip next contacts for this conf.'
3564 jcont_hb(num_conti,i)=j
3565 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3566 cd & " jcont_hb",jcont_hb(num_conti,i)
3567 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3568 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3569 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3571 d_cont(num_conti,i)=rij
3572 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3573 C --- Electrostatic-interaction matrix ---
3574 a_chuj(1,1,num_conti,i)=a22
3575 a_chuj(1,2,num_conti,i)=a23
3576 a_chuj(2,1,num_conti,i)=a32
3577 a_chuj(2,2,num_conti,i)=a33
3578 C --- Gradient of rij
3580 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3587 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3588 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3589 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3590 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3591 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3596 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3597 C Calculate contact energies
3599 wij=cosa-3.0D0*cosb*cosg
3602 c fac3=dsqrt(-ael6i)/r0ij**3
3603 fac3=dsqrt(-ael6i)*r3ij
3604 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3605 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3606 if (ees0tmp.gt.0) then
3607 ees0pij=dsqrt(ees0tmp)
3611 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3612 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3613 if (ees0tmp.gt.0) then
3614 ees0mij=dsqrt(ees0tmp)
3619 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3620 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3621 C Diagnostics. Comment out or remove after debugging!
3622 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3623 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3624 c ees0m(num_conti,i)=0.0D0
3626 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3627 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3628 C Angular derivatives of the contact function
3629 ees0pij1=fac3/ees0pij
3630 ees0mij1=fac3/ees0mij
3631 fac3p=-3.0D0*fac3*rrmij
3632 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3633 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3635 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3636 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3637 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3638 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3639 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3640 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3641 ecosap=ecosa1+ecosa2
3642 ecosbp=ecosb1+ecosb2
3643 ecosgp=ecosg1+ecosg2
3644 ecosam=ecosa1-ecosa2
3645 ecosbm=ecosb1-ecosb2
3646 ecosgm=ecosg1-ecosg2
3655 facont_hb(num_conti,i)=fcont
3656 fprimcont=fprimcont/rij
3657 cd facont_hb(num_conti,i)=1.0D0
3658 C Following line is for diagnostics.
3661 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3662 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3665 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3666 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3668 gggp(1)=gggp(1)+ees0pijp*xj
3669 gggp(2)=gggp(2)+ees0pijp*yj
3670 gggp(3)=gggp(3)+ees0pijp*zj
3671 gggm(1)=gggm(1)+ees0mijp*xj
3672 gggm(2)=gggm(2)+ees0mijp*yj
3673 gggm(3)=gggm(3)+ees0mijp*zj
3674 C Derivatives due to the contact function
3675 gacont_hbr(1,num_conti,i)=fprimcont*xj
3676 gacont_hbr(2,num_conti,i)=fprimcont*yj
3677 gacont_hbr(3,num_conti,i)=fprimcont*zj
3680 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3681 c following the change of gradient-summation algorithm.
3683 cgrad ghalfp=0.5D0*gggp(k)
3684 cgrad ghalfm=0.5D0*gggm(k)
3685 gacontp_hb1(k,num_conti,i)=!ghalfp
3686 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3687 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3688 gacontp_hb2(k,num_conti,i)=!ghalfp
3689 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3690 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3691 gacontp_hb3(k,num_conti,i)=gggp(k)
3692 gacontm_hb1(k,num_conti,i)=!ghalfm
3693 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3694 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3695 gacontm_hb2(k,num_conti,i)=!ghalfm
3696 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3697 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3698 gacontm_hb3(k,num_conti,i)=gggm(k)
3700 C Diagnostics. Comment out or remove after debugging!
3702 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3703 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3704 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3705 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3706 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3707 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3710 endif ! num_conti.le.maxconts
3713 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3716 ghalf=0.5d0*agg(l,k)
3717 aggi(l,k)=aggi(l,k)+ghalf
3718 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3719 aggj(l,k)=aggj(l,k)+ghalf
3722 if (j.eq.nres-1 .and. i.lt.j-2) then
3725 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3730 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3733 C-----------------------------------------------------------------------------
3734 subroutine eturn3(i,eello_turn3)
3735 C Third- and fourth-order contributions from turns
3736 implicit real*8 (a-h,o-z)
3737 include 'DIMENSIONS'
3738 include 'COMMON.IOUNITS'
3739 include 'COMMON.GEO'
3740 include 'COMMON.VAR'
3741 include 'COMMON.LOCAL'
3742 include 'COMMON.CHAIN'
3743 include 'COMMON.DERIV'
3744 include 'COMMON.INTERACT'
3745 include 'COMMON.CONTACTS'
3746 include 'COMMON.TORSION'
3747 include 'COMMON.VECTORS'
3748 include 'COMMON.FFIELD'
3749 include 'COMMON.CONTROL'
3751 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3752 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3753 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3754 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3755 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3756 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3757 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3760 c write (iout,*) "eturn3",i,j,j1,j2
3765 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3767 C Third-order contributions
3774 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3775 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3776 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3777 call transpose2(auxmat(1,1),auxmat1(1,1))
3778 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3779 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3780 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3781 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3782 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3783 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3784 cd & ' eello_turn3_num',4*eello_turn3_num
3785 C Derivatives in gamma(i)
3786 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3787 call transpose2(auxmat2(1,1),auxmat3(1,1))
3788 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3789 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3790 C Derivatives in gamma(i+1)
3791 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3792 call transpose2(auxmat2(1,1),auxmat3(1,1))
3793 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3794 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3795 & +0.5d0*(pizda(1,1)+pizda(2,2))
3796 C Cartesian derivatives
3798 c ghalf1=0.5d0*agg(l,1)
3799 c ghalf2=0.5d0*agg(l,2)
3800 c ghalf3=0.5d0*agg(l,3)
3801 c ghalf4=0.5d0*agg(l,4)
3802 a_temp(1,1)=aggi(l,1)!+ghalf1
3803 a_temp(1,2)=aggi(l,2)!+ghalf2
3804 a_temp(2,1)=aggi(l,3)!+ghalf3
3805 a_temp(2,2)=aggi(l,4)!+ghalf4
3806 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3807 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3808 & +0.5d0*(pizda(1,1)+pizda(2,2))
3809 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3810 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3811 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3812 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3813 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3814 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3815 & +0.5d0*(pizda(1,1)+pizda(2,2))
3816 a_temp(1,1)=aggj(l,1)!+ghalf1
3817 a_temp(1,2)=aggj(l,2)!+ghalf2
3818 a_temp(2,1)=aggj(l,3)!+ghalf3
3819 a_temp(2,2)=aggj(l,4)!+ghalf4
3820 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3821 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3822 & +0.5d0*(pizda(1,1)+pizda(2,2))
3823 a_temp(1,1)=aggj1(l,1)
3824 a_temp(1,2)=aggj1(l,2)
3825 a_temp(2,1)=aggj1(l,3)
3826 a_temp(2,2)=aggj1(l,4)
3827 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3828 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3829 & +0.5d0*(pizda(1,1)+pizda(2,2))
3833 C-------------------------------------------------------------------------------
3834 subroutine eturn4(i,eello_turn4)
3835 C Third- and fourth-order contributions from turns
3836 implicit real*8 (a-h,o-z)
3837 include 'DIMENSIONS'
3838 include 'COMMON.IOUNITS'
3839 include 'COMMON.GEO'
3840 include 'COMMON.VAR'
3841 include 'COMMON.LOCAL'
3842 include 'COMMON.CHAIN'
3843 include 'COMMON.DERIV'
3844 include 'COMMON.INTERACT'
3845 include 'COMMON.CONTACTS'
3846 include 'COMMON.TORSION'
3847 include 'COMMON.VECTORS'
3848 include 'COMMON.FFIELD'
3849 include 'COMMON.CONTROL'
3851 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3852 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3853 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3854 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3855 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3856 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3857 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3860 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3862 C Fourth-order contributions
3870 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3871 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3872 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3877 iti1=itortyp(itype(i+1))
3878 iti2=itortyp(itype(i+2))
3879 iti3=itortyp(itype(i+3))
3880 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3881 call transpose2(EUg(1,1,i+1),e1t(1,1))
3882 call transpose2(Eug(1,1,i+2),e2t(1,1))
3883 call transpose2(Eug(1,1,i+3),e3t(1,1))
3884 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3885 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3886 s1=scalar2(b1(1,iti2),auxvec(1))
3887 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3888 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3889 s2=scalar2(b1(1,iti1),auxvec(1))
3890 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3891 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3892 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3893 eello_turn4=eello_turn4-(s1+s2+s3)
3894 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
3895 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
3896 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
3897 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3898 cd & ' eello_turn4_num',8*eello_turn4_num
3899 C Derivatives in gamma(i)
3900 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3901 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3902 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3903 s1=scalar2(b1(1,iti2),auxvec(1))
3904 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3905 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3906 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3907 C Derivatives in gamma(i+1)
3908 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3909 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3910 s2=scalar2(b1(1,iti1),auxvec(1))
3911 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3912 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3913 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3914 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3915 C Derivatives in gamma(i+2)
3916 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3917 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3918 s1=scalar2(b1(1,iti2),auxvec(1))
3919 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3920 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3921 s2=scalar2(b1(1,iti1),auxvec(1))
3922 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3923 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3924 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3925 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3926 C Cartesian derivatives
3927 C Derivatives of this turn contributions in DC(i+2)
3928 if (j.lt.nres-1) then
3930 a_temp(1,1)=agg(l,1)
3931 a_temp(1,2)=agg(l,2)
3932 a_temp(2,1)=agg(l,3)
3933 a_temp(2,2)=agg(l,4)
3934 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3935 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3936 s1=scalar2(b1(1,iti2),auxvec(1))
3937 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3938 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3939 s2=scalar2(b1(1,iti1),auxvec(1))
3940 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3941 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3942 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3944 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3947 C Remaining derivatives of this turn contribution
3949 a_temp(1,1)=aggi(l,1)
3950 a_temp(1,2)=aggi(l,2)
3951 a_temp(2,1)=aggi(l,3)
3952 a_temp(2,2)=aggi(l,4)
3953 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3954 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3955 s1=scalar2(b1(1,iti2),auxvec(1))
3956 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3957 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3958 s2=scalar2(b1(1,iti1),auxvec(1))
3959 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3960 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3961 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3962 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3963 a_temp(1,1)=aggi1(l,1)
3964 a_temp(1,2)=aggi1(l,2)
3965 a_temp(2,1)=aggi1(l,3)
3966 a_temp(2,2)=aggi1(l,4)
3967 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3968 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3969 s1=scalar2(b1(1,iti2),auxvec(1))
3970 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3971 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3972 s2=scalar2(b1(1,iti1),auxvec(1))
3973 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3974 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3975 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3976 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3977 a_temp(1,1)=aggj(l,1)
3978 a_temp(1,2)=aggj(l,2)
3979 a_temp(2,1)=aggj(l,3)
3980 a_temp(2,2)=aggj(l,4)
3981 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3982 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3983 s1=scalar2(b1(1,iti2),auxvec(1))
3984 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3985 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3986 s2=scalar2(b1(1,iti1),auxvec(1))
3987 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3988 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3989 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3990 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3991 a_temp(1,1)=aggj1(l,1)
3992 a_temp(1,2)=aggj1(l,2)
3993 a_temp(2,1)=aggj1(l,3)
3994 a_temp(2,2)=aggj1(l,4)
3995 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3996 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3997 s1=scalar2(b1(1,iti2),auxvec(1))
3998 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3999 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4000 s2=scalar2(b1(1,iti1),auxvec(1))
4001 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4002 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4003 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4004 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4005 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4009 C-----------------------------------------------------------------------------
4010 subroutine vecpr(u,v,w)
4011 implicit real*8(a-h,o-z)
4012 dimension u(3),v(3),w(3)
4013 w(1)=u(2)*v(3)-u(3)*v(2)
4014 w(2)=-u(1)*v(3)+u(3)*v(1)
4015 w(3)=u(1)*v(2)-u(2)*v(1)
4018 C-----------------------------------------------------------------------------
4019 subroutine unormderiv(u,ugrad,unorm,ungrad)
4020 C This subroutine computes the derivatives of a normalized vector u, given
4021 C the derivatives computed without normalization conditions, ugrad. Returns
4024 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4025 double precision vec(3)
4026 double precision scalar
4028 c write (2,*) 'ugrad',ugrad
4031 vec(i)=scalar(ugrad(1,i),u(1))
4033 c write (2,*) 'vec',vec
4036 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4039 c write (2,*) 'ungrad',ungrad
4042 C-----------------------------------------------------------------------------
4043 subroutine escp_soft_sphere(evdw2,evdw2_14)
4045 C This subroutine calculates the excluded-volume interaction energy between
4046 C peptide-group centers and side chains and its gradient in virtual-bond and
4047 C side-chain vectors.
4049 implicit real*8 (a-h,o-z)
4050 include 'DIMENSIONS'
4051 include 'COMMON.GEO'
4052 include 'COMMON.VAR'
4053 include 'COMMON.LOCAL'
4054 include 'COMMON.CHAIN'
4055 include 'COMMON.DERIV'
4056 include 'COMMON.INTERACT'
4057 include 'COMMON.FFIELD'
4058 include 'COMMON.IOUNITS'
4059 include 'COMMON.CONTROL'
4064 cd print '(a)','Enter ESCP'
4065 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4069 do i=iatscp_s,iatscp_e
4070 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4072 xi=0.5D0*(c(1,i)+c(1,i+1))
4073 yi=0.5D0*(c(2,i)+c(2,i+1))
4074 zi=0.5D0*(c(3,i)+c(3,i+1))
4075 C Return atom into box, boxxsize is size of box in x dimension
4077 if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4078 if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4079 C Condition for being inside the proper box
4080 if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4081 & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4085 if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4086 if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4087 C Condition for being inside the proper box
4088 if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4089 & (yi.lt.((yshift-0.5d0)*boxysize))) then
4093 if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4094 if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4095 C Condition for being inside the proper box
4096 if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4097 & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4100 do iint=1,nscp_gr(i)
4102 do j=iscpstart(i,iint),iscpend(i,iint)
4103 if (itype(j).eq.ntyp1) cycle
4104 itypj=iabs(itype(j))
4105 C Uncomment following three lines for SC-p interactions
4109 C Uncomment following three lines for Ca-p interactions
4114 if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4115 if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4116 C Condition for being inside the proper box
4117 if ((xj.gt.((0.5d0)*boxxsize)).or.
4118 & (xj.lt.((-0.5d0)*boxxsize))) then
4122 if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4123 if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4124 C Condition for being inside the proper box
4125 if ((yj.gt.((0.5d0)*boxysize)).or.
4126 & (yj.lt.((-0.5d0)*boxysize))) then
4130 if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4131 if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4132 C Condition for being inside the proper box
4133 if ((zj.gt.((0.5d0)*boxzsize)).or.
4134 & (zj.lt.((-0.5d0)*boxzsize))) then
4140 rij=xj*xj+yj*yj+zj*zj
4144 if (rij.lt.r0ijsq) then
4145 evdwij=0.25d0*(rij-r0ijsq)**2
4153 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4158 cgrad if (j.lt.i) then
4159 cd write (iout,*) 'j<i'
4160 C Uncomment following three lines for SC-p interactions
4162 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4165 cd write (iout,*) 'j>i'
4167 cgrad ggg(k)=-ggg(k)
4168 C Uncomment following line for SC-p interactions
4169 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4173 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4175 cgrad kstart=min0(i+1,j)
4176 cgrad kend=max0(i-1,j-1)
4177 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4178 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4179 cgrad do k=kstart,kend
4181 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4185 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4186 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4197 C-----------------------------------------------------------------------------
4198 subroutine escp(evdw2,evdw2_14)
4200 C This subroutine calculates the excluded-volume interaction energy between
4201 C peptide-group centers and side chains and its gradient in virtual-bond and
4202 C side-chain vectors.
4204 implicit real*8 (a-h,o-z)
4205 include 'DIMENSIONS'
4206 include 'COMMON.GEO'
4207 include 'COMMON.VAR'
4208 include 'COMMON.LOCAL'
4209 include 'COMMON.CHAIN'
4210 include 'COMMON.DERIV'
4211 include 'COMMON.INTERACT'
4212 include 'COMMON.FFIELD'
4213 include 'COMMON.IOUNITS'
4214 include 'COMMON.CONTROL'
4215 include 'COMMON.SPLITELE'
4219 cd print '(a)','Enter ESCP'
4220 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4224 do i=iatscp_s,iatscp_e
4225 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4227 xi=0.5D0*(c(1,i)+c(1,i+1))
4228 yi=0.5D0*(c(2,i)+c(2,i+1))
4229 zi=0.5D0*(c(3,i)+c(3,i+1))
4230 C Return atom into box, boxxsize is size of box in x dimension
4232 if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4233 if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4234 C Condition for being inside the proper box
4235 if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4236 & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4240 if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4241 if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4242 C Condition for being inside the proper box
4243 if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4244 & (yi.lt.((yshift-0.5d0)*boxysize))) then
4248 if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4249 if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4250 C Condition for being inside the proper box
4251 if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4252 & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4255 do iint=1,nscp_gr(i)
4257 do j=iscpstart(i,iint),iscpend(i,iint)
4258 itypj=iabs(itype(j))
4259 if (itypj.eq.ntyp1) cycle
4260 C Uncomment following three lines for SC-p interactions
4264 C Uncomment following three lines for Ca-p interactions
4269 if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4270 if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4271 C Condition for being inside the proper box
4272 if ((xj.gt.((0.5d0)*boxxsize)).or.
4273 & (xj.lt.((-0.5d0)*boxxsize))) then
4277 if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4278 if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4279 C Condition for being inside the proper box
4280 if ((yj.gt.((0.5d0)*boxysize)).or.
4281 & (yj.lt.((-0.5d0)*boxysize))) then
4285 if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4286 if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4287 C Condition for being inside the proper box
4288 if ((zj.gt.((0.5d0)*boxzsize)).or.
4289 & (zj.lt.((-0.5d0)*boxzsize))) then
4295 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4296 sss=sscale(1.0d0/(dsqrt(rrij)))
4297 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4298 if (sss.gt.0.0d0) then
4300 e1=fac*fac*aad(itypj,iteli)
4301 e2=fac*bad(itypj,iteli)
4302 if (iabs(j-i) .le. 2) then
4305 evdw2_14=evdw2_14+(e1+e2)*sss
4308 evdw2=evdw2+evdwij*sss
4309 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4310 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4313 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4315 fac=-(evdwij+e1)*rrij*sss
4316 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4320 cgrad if (j.lt.i) then
4321 cd write (iout,*) 'j<i'
4322 C Uncomment following three lines for SC-p interactions
4324 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4327 cd write (iout,*) 'j>i'
4329 cgrad ggg(k)=-ggg(k)
4330 C Uncomment following line for SC-p interactions
4331 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4332 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4336 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4338 cgrad kstart=min0(i+1,j)
4339 cgrad kend=max0(i-1,j-1)
4340 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4341 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4342 cgrad do k=kstart,kend
4344 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4348 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4349 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4351 endif !endif for sscale cutoff
4361 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4362 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4363 gradx_scp(j,i)=expon*gradx_scp(j,i)
4366 C******************************************************************************
4370 C To save time the factor EXPON has been extracted from ALL components
4371 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4374 C******************************************************************************
4377 C--------------------------------------------------------------------------
4378 subroutine edis(ehpb)
4380 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4382 implicit real*8 (a-h,o-z)
4383 include 'DIMENSIONS'
4384 include 'COMMON.SBRIDGE'
4385 include 'COMMON.CHAIN'
4386 include 'COMMON.DERIV'
4387 include 'COMMON.VAR'
4388 include 'COMMON.INTERACT'
4389 include 'COMMON.IOUNITS'
4392 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4393 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4394 if (link_end.eq.0) return
4395 do i=link_start,link_end
4396 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4397 C CA-CA distance used in regularization of structure.
4400 C iii and jjj point to the residues for which the distance is assigned.
4401 if (ii.gt.nres) then
4408 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4409 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4410 C distance and angle dependent SS bond potential.
4411 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4412 & iabs(itype(jjj)).eq.1) then
4413 call ssbond_ene(iii,jjj,eij)
4415 cd write (iout,*) "eij",eij
4417 C Calculate the distance between the two points and its difference from the
4421 C Get the force constant corresponding to this distance.
4423 C Calculate the contribution to energy.
4424 ehpb=ehpb+waga*rdis*rdis
4426 C Evaluate gradient.
4429 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4430 cd & ' waga=',waga,' fac=',fac
4432 ggg(j)=fac*(c(j,jj)-c(j,ii))
4434 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4435 C If this is a SC-SC distance, we need to calculate the contributions to the
4436 C Cartesian gradient in the SC vectors (ghpbx).
4439 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4440 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4443 cgrad do j=iii,jjj-1
4445 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4449 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4450 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4457 C--------------------------------------------------------------------------
4458 subroutine ssbond_ene(i,j,eij)
4460 C Calculate the distance and angle dependent SS-bond potential energy
4461 C using a free-energy function derived based on RHF/6-31G** ab initio
4462 C calculations of diethyl disulfide.
4464 C A. Liwo and U. Kozlowska, 11/24/03
4466 implicit real*8 (a-h,o-z)
4467 include 'DIMENSIONS'
4468 include 'COMMON.SBRIDGE'
4469 include 'COMMON.CHAIN'
4470 include 'COMMON.DERIV'
4471 include 'COMMON.LOCAL'
4472 include 'COMMON.INTERACT'
4473 include 'COMMON.VAR'
4474 include 'COMMON.IOUNITS'
4475 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4476 itypi=iabs(itype(i))
4480 dxi=dc_norm(1,nres+i)
4481 dyi=dc_norm(2,nres+i)
4482 dzi=dc_norm(3,nres+i)
4483 c dsci_inv=dsc_inv(itypi)
4484 dsci_inv=vbld_inv(nres+i)
4485 itypj=iabs(itype(j))
4486 c dscj_inv=dsc_inv(itypj)
4487 dscj_inv=vbld_inv(nres+j)
4491 dxj=dc_norm(1,nres+j)
4492 dyj=dc_norm(2,nres+j)
4493 dzj=dc_norm(3,nres+j)
4494 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4499 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4500 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4501 om12=dxi*dxj+dyi*dyj+dzi*dzj
4503 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4504 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4510 deltat12=om2-om1+2.0d0
4512 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4513 & +akct*deltad*deltat12
4514 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4515 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4516 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4517 c & " deltat12",deltat12," eij",eij
4518 ed=2*akcm*deltad+akct*deltat12
4520 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4521 eom1=-2*akth*deltat1-pom1-om2*pom2
4522 eom2= 2*akth*deltat2+pom1-om1*pom2
4525 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4526 ghpbx(k,i)=ghpbx(k,i)-ggk
4527 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4528 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4529 ghpbx(k,j)=ghpbx(k,j)+ggk
4530 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4531 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4532 ghpbc(k,i)=ghpbc(k,i)-ggk
4533 ghpbc(k,j)=ghpbc(k,j)+ggk
4536 C Calculate the components of the gradient in DC and X
4540 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4545 C--------------------------------------------------------------------------
4546 subroutine ebond(estr)
4548 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4550 implicit real*8 (a-h,o-z)
4551 include 'DIMENSIONS'
4552 include 'COMMON.LOCAL'
4553 include 'COMMON.GEO'
4554 include 'COMMON.INTERACT'
4555 include 'COMMON.DERIV'
4556 include 'COMMON.VAR'
4557 include 'COMMON.CHAIN'
4558 include 'COMMON.IOUNITS'
4559 include 'COMMON.NAMES'
4560 include 'COMMON.FFIELD'
4561 include 'COMMON.CONTROL'
4562 include 'COMMON.SETUP'
4563 double precision u(3),ud(3)
4566 do i=ibondp_start,ibondp_end
4567 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4568 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4570 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4571 c & *dc(j,i-1)/vbld(i)
4573 c if (energy_dec) write(iout,*)
4574 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4576 C Checking if it involves dummy (NH3+ or COO-) group
4577 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4578 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
4579 diff = vbld(i)-vbldpDUM
4581 C NO vbldp0 is the equlibrium lenght of spring for peptide group
4582 diff = vbld(i)-vbldp0
4584 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
4585 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4588 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4590 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4593 estr=0.5d0*AKP*estr+estr1
4595 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4597 do i=ibond_start,ibond_end
4599 if (iti.ne.10 .and. iti.ne.ntyp1) then
4602 diff=vbld(i+nres)-vbldsc0(1,iti)
4603 if (energy_dec) write (iout,*)
4604 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4605 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4606 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4608 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4612 diff=vbld(i+nres)-vbldsc0(j,iti)
4613 ud(j)=aksc(j,iti)*diff
4614 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4628 uprod2=uprod2*u(k)*u(k)
4632 usumsqder=usumsqder+ud(j)*uprod2
4634 estr=estr+uprod/usum
4636 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4644 C--------------------------------------------------------------------------
4645 subroutine ebend(etheta)
4647 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4648 C angles gamma and its derivatives in consecutive thetas and gammas.
4650 implicit real*8 (a-h,o-z)
4651 include 'DIMENSIONS'
4652 include 'COMMON.LOCAL'
4653 include 'COMMON.GEO'
4654 include 'COMMON.INTERACT'
4655 include 'COMMON.DERIV'
4656 include 'COMMON.VAR'
4657 include 'COMMON.CHAIN'
4658 include 'COMMON.IOUNITS'
4659 include 'COMMON.NAMES'
4660 include 'COMMON.FFIELD'
4661 include 'COMMON.CONTROL'
4662 common /calcthet/ term1,term2,termm,diffak,ratak,
4663 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4664 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4665 double precision y(2),z(2)
4667 c time11=dexp(-2*time)
4670 c write (*,'(a,i2)') 'EBEND ICG=',icg
4671 do i=ithet_start,ithet_end
4672 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4673 & .or.itype(i).eq.ntyp1) cycle
4674 C Zero the energy function and its derivative at 0 or pi.
4675 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4677 ichir1=isign(1,itype(i-2))
4678 ichir2=isign(1,itype(i))
4679 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4680 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4681 if (itype(i-1).eq.10) then
4682 itype1=isign(10,itype(i-2))
4683 ichir11=isign(1,itype(i-2))
4684 ichir12=isign(1,itype(i-2))
4685 itype2=isign(10,itype(i))
4686 ichir21=isign(1,itype(i))
4687 ichir22=isign(1,itype(i))
4690 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4693 if (phii.ne.phii) phii=150.0
4703 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4706 if (phii1.ne.phii1) phii1=150.0
4718 C Calculate the "mean" value of theta from the part of the distribution
4719 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4720 C In following comments this theta will be referred to as t_c.
4721 thet_pred_mean=0.0d0
4723 athetk=athet(k,it,ichir1,ichir2)
4724 bthetk=bthet(k,it,ichir1,ichir2)
4726 athetk=athet(k,itype1,ichir11,ichir12)
4727 bthetk=bthet(k,itype2,ichir21,ichir22)
4729 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4730 c write(iout,*) 'chuj tu', y(k),z(k)
4732 dthett=thet_pred_mean*ssd
4733 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4734 C Derivatives of the "mean" values in gamma1 and gamma2.
4735 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4736 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4737 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4738 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4740 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4741 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4742 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4743 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4745 if (theta(i).gt.pi-delta) then
4746 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4748 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4749 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4750 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4752 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4754 else if (theta(i).lt.delta) then
4755 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4756 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4757 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4759 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4760 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4763 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4766 etheta=etheta+ethetai
4767 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4768 & 'ebend',i,ethetai,theta(i),itype(i)
4769 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4770 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4771 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
4773 C Ufff.... We've done all this!!!
4776 C---------------------------------------------------------------------------
4777 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4779 implicit real*8 (a-h,o-z)
4780 include 'DIMENSIONS'
4781 include 'COMMON.LOCAL'
4782 include 'COMMON.IOUNITS'
4783 common /calcthet/ term1,term2,termm,diffak,ratak,
4784 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4785 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4786 C Calculate the contributions to both Gaussian lobes.
4787 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4788 C The "polynomial part" of the "standard deviation" of this part of
4789 C the distributioni.
4790 ccc write (iout,*) thetai,thet_pred_mean
4793 sig=sig*thet_pred_mean+polthet(j,it)
4795 C Derivative of the "interior part" of the "standard deviation of the"
4796 C gamma-dependent Gaussian lobe in t_c.
4797 sigtc=3*polthet(3,it)
4799 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4802 C Set the parameters of both Gaussian lobes of the distribution.
4803 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4804 fac=sig*sig+sigc0(it)
4807 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4808 sigsqtc=-4.0D0*sigcsq*sigtc
4809 c print *,i,sig,sigtc,sigsqtc
4810 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4811 sigtc=-sigtc/(fac*fac)
4812 C Following variable is sigma(t_c)**(-2)
4813 sigcsq=sigcsq*sigcsq
4815 sig0inv=1.0D0/sig0i**2
4816 delthec=thetai-thet_pred_mean
4817 delthe0=thetai-theta0i
4818 term1=-0.5D0*sigcsq*delthec*delthec
4819 term2=-0.5D0*sig0inv*delthe0*delthe0
4820 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
4821 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4822 C NaNs in taking the logarithm. We extract the largest exponent which is added
4823 C to the energy (this being the log of the distribution) at the end of energy
4824 C term evaluation for this virtual-bond angle.
4825 if (term1.gt.term2) then
4827 term2=dexp(term2-termm)
4831 term1=dexp(term1-termm)
4834 C The ratio between the gamma-independent and gamma-dependent lobes of
4835 C the distribution is a Gaussian function of thet_pred_mean too.
4836 diffak=gthet(2,it)-thet_pred_mean
4837 ratak=diffak/gthet(3,it)**2
4838 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4839 C Let's differentiate it in thet_pred_mean NOW.
4841 C Now put together the distribution terms to make complete distribution.
4842 termexp=term1+ak*term2
4843 termpre=sigc+ak*sig0i
4844 C Contribution of the bending energy from this theta is just the -log of
4845 C the sum of the contributions from the two lobes and the pre-exponential
4846 C factor. Simple enough, isn't it?
4847 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4848 C write (iout,*) 'termexp',termexp,termm,termpre,i
4849 C NOW the derivatives!!!
4850 C 6/6/97 Take into account the deformation.
4851 E_theta=(delthec*sigcsq*term1
4852 & +ak*delthe0*sig0inv*term2)/termexp
4853 E_tc=((sigtc+aktc*sig0i)/termpre
4854 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4855 & aktc*term2)/termexp)
4858 c-----------------------------------------------------------------------------
4859 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4860 implicit real*8 (a-h,o-z)
4861 include 'DIMENSIONS'
4862 include 'COMMON.LOCAL'
4863 include 'COMMON.IOUNITS'
4864 common /calcthet/ term1,term2,termm,diffak,ratak,
4865 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4866 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4867 delthec=thetai-thet_pred_mean
4868 delthe0=thetai-theta0i
4869 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4870 t3 = thetai-thet_pred_mean
4874 t14 = t12+t6*sigsqtc
4876 t21 = thetai-theta0i
4882 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4883 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4884 & *(-t12*t9-ak*sig0inv*t27)
4888 C--------------------------------------------------------------------------
4889 subroutine ebend(etheta)
4891 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4892 C angles gamma and its derivatives in consecutive thetas and gammas.
4893 C ab initio-derived potentials from
4894 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4896 implicit real*8 (a-h,o-z)
4897 include 'DIMENSIONS'
4898 include 'COMMON.LOCAL'
4899 include 'COMMON.GEO'
4900 include 'COMMON.INTERACT'
4901 include 'COMMON.DERIV'
4902 include 'COMMON.VAR'
4903 include 'COMMON.CHAIN'
4904 include 'COMMON.IOUNITS'
4905 include 'COMMON.NAMES'
4906 include 'COMMON.FFIELD'
4907 include 'COMMON.CONTROL'
4908 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4909 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4910 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4911 & sinph1ph2(maxdouble,maxdouble)
4912 logical lprn /.false./, lprn1 /.false./
4914 do i=ithet_start,ithet_end
4915 c print *,i,itype(i-1),itype(i),itype(i-2)
4916 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4917 & .or.itype(i).eq.ntyp1) cycle
4918 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
4920 if (iabs(itype(i+1)).eq.20) iblock=2
4921 if (iabs(itype(i+1)).ne.20) iblock=1
4925 theti2=0.5d0*theta(i)
4926 ityp2=ithetyp((itype(i-1)))
4928 coskt(k)=dcos(k*theti2)
4929 sinkt(k)=dsin(k*theti2)
4931 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4934 if (phii.ne.phii) phii=150.0
4938 ityp1=ithetyp((itype(i-2)))
4939 C propagation of chirality for glycine type
4941 cosph1(k)=dcos(k*phii)
4942 sinph1(k)=dsin(k*phii)
4952 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4955 if (phii1.ne.phii1) phii1=150.0
4960 ityp3=ithetyp((itype(i)))
4962 cosph2(k)=dcos(k*phii1)
4963 sinph2(k)=dsin(k*phii1)
4973 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4976 ccl=cosph1(l)*cosph2(k-l)
4977 ssl=sinph1(l)*sinph2(k-l)
4978 scl=sinph1(l)*cosph2(k-l)
4979 csl=cosph1(l)*sinph2(k-l)
4980 cosph1ph2(l,k)=ccl-ssl
4981 cosph1ph2(k,l)=ccl+ssl
4982 sinph1ph2(l,k)=scl+csl
4983 sinph1ph2(k,l)=scl-csl
4987 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4988 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4989 write (iout,*) "coskt and sinkt"
4991 write (iout,*) k,coskt(k),sinkt(k)
4995 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4996 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4999 & write (iout,*) "k",k,"
5000 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5001 & " ethetai",ethetai
5004 write (iout,*) "cosph and sinph"
5006 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5008 write (iout,*) "cosph1ph2 and sinph2ph2"
5011 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5012 & sinph1ph2(l,k),sinph1ph2(k,l)
5015 write(iout,*) "ethetai",ethetai
5019 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5020 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5021 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5022 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5023 ethetai=ethetai+sinkt(m)*aux
5024 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5025 dephii=dephii+k*sinkt(m)*(
5026 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5027 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5028 dephii1=dephii1+k*sinkt(m)*(
5029 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5030 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5032 & write (iout,*) "m",m," k",k," bbthet",
5033 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5034 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5035 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5036 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5040 & write(iout,*) "ethetai",ethetai
5044 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5045 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5046 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5047 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5048 ethetai=ethetai+sinkt(m)*aux
5049 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5050 dephii=dephii+l*sinkt(m)*(
5051 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5052 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5053 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5054 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5055 dephii1=dephii1+(k-l)*sinkt(m)*(
5056 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5057 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5058 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5059 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5061 write (iout,*) "m",m," k",k," l",l," ffthet",
5062 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5063 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5064 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5065 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5066 & " ethetai",ethetai
5067 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5068 & cosph1ph2(k,l)*sinkt(m),
5069 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5077 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5078 & i,theta(i)*rad2deg,phii*rad2deg,
5079 & phii1*rad2deg,ethetai
5081 etheta=etheta+ethetai
5082 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5083 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5084 gloc(nphi+i-2,icg)=wang*dethetai+ gloc(nphi+i-2,icg)
5090 c-----------------------------------------------------------------------------
5091 subroutine esc(escloc)
5092 C Calculate the local energy of a side chain and its derivatives in the
5093 C corresponding virtual-bond valence angles THETA and the spherical angles
5095 implicit real*8 (a-h,o-z)
5096 include 'DIMENSIONS'
5097 include 'COMMON.GEO'
5098 include 'COMMON.LOCAL'
5099 include 'COMMON.VAR'
5100 include 'COMMON.INTERACT'
5101 include 'COMMON.DERIV'
5102 include 'COMMON.CHAIN'
5103 include 'COMMON.IOUNITS'
5104 include 'COMMON.NAMES'
5105 include 'COMMON.FFIELD'
5106 include 'COMMON.CONTROL'
5107 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5108 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5109 common /sccalc/ time11,time12,time112,theti,it,nlobit
5112 c write (iout,'(a)') 'ESC'
5113 do i=loc_start,loc_end
5115 if (it.eq.ntyp1) cycle
5116 if (it.eq.10) goto 1
5117 nlobit=nlob(iabs(it))
5118 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5119 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5120 theti=theta(i+1)-pipol
5125 if (x(2).gt.pi-delta) then
5129 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5131 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5132 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5134 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5135 & ddersc0(1),dersc(1))
5136 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5137 & ddersc0(3),dersc(3))
5139 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5141 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5142 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5143 & dersc0(2),esclocbi,dersc02)
5144 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5146 call splinthet(x(2),0.5d0*delta,ss,ssd)
5151 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5153 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5154 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5156 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5158 c write (iout,*) escloci
5159 else if (x(2).lt.delta) then
5163 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5165 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5166 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5168 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5169 & ddersc0(1),dersc(1))
5170 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5171 & ddersc0(3),dersc(3))
5173 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5175 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5176 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5177 & dersc0(2),esclocbi,dersc02)
5178 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5183 call splinthet(x(2),0.5d0*delta,ss,ssd)
5185 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5187 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5188 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5190 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5191 c write (iout,*) escloci
5193 call enesc(x,escloci,dersc,ddummy,.false.)
5196 escloc=escloc+escloci
5197 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5198 & 'escloc',i,escloci
5199 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5201 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5203 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5204 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5209 C---------------------------------------------------------------------------
5210 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5211 implicit real*8 (a-h,o-z)
5212 include 'DIMENSIONS'
5213 include 'COMMON.GEO'
5214 include 'COMMON.LOCAL'
5215 include 'COMMON.IOUNITS'
5216 common /sccalc/ time11,time12,time112,theti,it,nlobit
5217 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5218 double precision contr(maxlob,-1:1)
5220 c write (iout,*) 'it=',it,' nlobit=',nlobit
5224 if (mixed) ddersc(j)=0.0d0
5228 C Because of periodicity of the dependence of the SC energy in omega we have
5229 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5230 C To avoid underflows, first compute & store the exponents.
5238 z(k)=x(k)-censc(k,j,it)
5243 Axk=Axk+gaussc(l,k,j,it)*z(l)
5249 expfac=expfac+Ax(k,j,iii)*z(k)
5257 C As in the case of ebend, we want to avoid underflows in exponentiation and
5258 C subsequent NaNs and INFs in energy calculation.
5259 C Find the largest exponent
5263 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5267 cd print *,'it=',it,' emin=',emin
5269 C Compute the contribution to SC energy and derivatives
5274 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5275 if(adexp.ne.adexp) adexp=1.0
5278 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5280 cd print *,'j=',j,' expfac=',expfac
5281 escloc_i=escloc_i+expfac
5283 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5287 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5288 & +gaussc(k,2,j,it))*expfac
5295 dersc(1)=dersc(1)/cos(theti)**2
5296 ddersc(1)=ddersc(1)/cos(theti)**2
5299 escloci=-(dlog(escloc_i)-emin)
5301 dersc(j)=dersc(j)/escloc_i
5305 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5310 C------------------------------------------------------------------------------
5311 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5312 implicit real*8 (a-h,o-z)
5313 include 'DIMENSIONS'
5314 include 'COMMON.GEO'
5315 include 'COMMON.LOCAL'
5316 include 'COMMON.IOUNITS'
5317 common /sccalc/ time11,time12,time112,theti,it,nlobit
5318 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5319 double precision contr(maxlob)
5330 z(k)=x(k)-censc(k,j,it)
5336 Axk=Axk+gaussc(l,k,j,it)*z(l)
5342 expfac=expfac+Ax(k,j)*z(k)
5347 C As in the case of ebend, we want to avoid underflows in exponentiation and
5348 C subsequent NaNs and INFs in energy calculation.
5349 C Find the largest exponent
5352 if (emin.gt.contr(j)) emin=contr(j)
5356 C Compute the contribution to SC energy and derivatives
5360 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5361 escloc_i=escloc_i+expfac
5363 dersc(k)=dersc(k)+Ax(k,j)*expfac
5365 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5366 & +gaussc(1,2,j,it))*expfac
5370 dersc(1)=dersc(1)/cos(theti)**2
5371 dersc12=dersc12/cos(theti)**2
5372 escloci=-(dlog(escloc_i)-emin)
5374 dersc(j)=dersc(j)/escloc_i
5376 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5380 c----------------------------------------------------------------------------------
5381 subroutine esc(escloc)
5382 C Calculate the local energy of a side chain and its derivatives in the
5383 C corresponding virtual-bond valence angles THETA and the spherical angles
5384 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5385 C added by Urszula Kozlowska. 07/11/2007
5387 implicit real*8 (a-h,o-z)
5388 include 'DIMENSIONS'
5389 include 'COMMON.GEO'
5390 include 'COMMON.LOCAL'
5391 include 'COMMON.VAR'
5392 include 'COMMON.SCROT'
5393 include 'COMMON.INTERACT'
5394 include 'COMMON.DERIV'
5395 include 'COMMON.CHAIN'
5396 include 'COMMON.IOUNITS'
5397 include 'COMMON.NAMES'
5398 include 'COMMON.FFIELD'
5399 include 'COMMON.CONTROL'
5400 include 'COMMON.VECTORS'
5401 double precision x_prime(3),y_prime(3),z_prime(3)
5402 & , sumene,dsc_i,dp2_i,x(65),
5403 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5404 & de_dxx,de_dyy,de_dzz,de_dt
5405 double precision s1_t,s1_6_t,s2_t,s2_6_t
5407 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5408 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5409 & dt_dCi(3),dt_dCi1(3)
5410 common /sccalc/ time11,time12,time112,theti,it,nlobit
5413 do i=loc_start,loc_end
5414 if (itype(i).eq.ntyp1) cycle
5415 costtab(i+1) =dcos(theta(i+1))
5416 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5417 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5418 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5419 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5420 cosfac=dsqrt(cosfac2)
5421 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5422 sinfac=dsqrt(sinfac2)
5424 if (it.eq.10) goto 1
5426 C Compute the axes of tghe local cartesian coordinates system; store in
5427 c x_prime, y_prime and z_prime
5434 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5435 C & dc_norm(3,i+nres)
5437 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5438 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5441 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5444 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5445 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5446 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5447 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5448 c & " xy",scalar(x_prime(1),y_prime(1)),
5449 c & " xz",scalar(x_prime(1),z_prime(1)),
5450 c & " yy",scalar(y_prime(1),y_prime(1)),
5451 c & " yz",scalar(y_prime(1),z_prime(1)),
5452 c & " zz",scalar(z_prime(1),z_prime(1))
5454 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5455 C to local coordinate system. Store in xx, yy, zz.
5461 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5462 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5463 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5470 C Compute the energy of the ith side cbain
5472 c write (2,*) "xx",xx," yy",yy," zz",zz
5475 x(j) = sc_parmin(j,it)
5478 Cc diagnostics - remove later
5480 yy1 = dsin(alph(2))*dcos(omeg(2))
5481 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5482 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5483 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5485 C," --- ", xx_w,yy_w,zz_w
5488 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5489 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5491 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5492 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5494 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5495 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5496 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5497 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5498 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5500 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5501 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5502 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5503 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5504 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5506 dsc_i = 0.743d0+x(61)
5508 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5509 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5510 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5511 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5512 s1=(1+x(63))/(0.1d0 + dscp1)
5513 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5514 s2=(1+x(65))/(0.1d0 + dscp2)
5515 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5516 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5517 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5518 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5520 c & dscp1,dscp2,sumene
5521 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5522 escloc = escloc + sumene
5523 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5528 C This section to check the numerical derivatives of the energy of ith side
5529 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5530 C #define DEBUG in the code to turn it on.
5532 write (2,*) "sumene =",sumene
5536 write (2,*) xx,yy,zz
5537 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5538 de_dxx_num=(sumenep-sumene)/aincr
5540 write (2,*) "xx+ sumene from enesc=",sumenep
5543 write (2,*) xx,yy,zz
5544 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5545 de_dyy_num=(sumenep-sumene)/aincr
5547 write (2,*) "yy+ sumene from enesc=",sumenep
5550 write (2,*) xx,yy,zz
5551 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5552 de_dzz_num=(sumenep-sumene)/aincr
5554 write (2,*) "zz+ sumene from enesc=",sumenep
5555 costsave=cost2tab(i+1)
5556 sintsave=sint2tab(i+1)
5557 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5558 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5559 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5560 de_dt_num=(sumenep-sumene)/aincr
5561 write (2,*) " t+ sumene from enesc=",sumenep
5562 cost2tab(i+1)=costsave
5563 sint2tab(i+1)=sintsave
5564 C End of diagnostics section.
5567 C Compute the gradient of esc
5569 c zz=zz*dsign(1.0,dfloat(itype(i)))
5570 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5571 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5572 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5573 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5574 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5575 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5576 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5577 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5578 pom1=(sumene3*sint2tab(i+1)+sumene1)
5579 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5580 pom2=(sumene4*cost2tab(i+1)+sumene2)
5581 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5582 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5583 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5584 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5586 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5587 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5588 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5590 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5591 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5592 & +(pom1+pom2)*pom_dx
5594 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5597 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5598 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5599 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5601 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5602 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5603 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5604 & +x(59)*zz**2 +x(60)*xx*zz
5605 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5606 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5607 & +(pom1-pom2)*pom_dy
5609 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5612 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5613 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5614 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5615 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5616 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5617 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5618 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5619 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5621 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5624 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5625 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5626 & +pom1*pom_dt1+pom2*pom_dt2
5628 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5633 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5634 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5635 cosfac2xx=cosfac2*xx
5636 sinfac2yy=sinfac2*yy
5638 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5640 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5642 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5643 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5644 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5645 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5646 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5647 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5648 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5649 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5650 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5651 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5655 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5656 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5657 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5658 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5661 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5662 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5663 dZZ_XYZ(k)=vbld_inv(i+nres)*
5664 & (z_prime(k)-zz*dC_norm(k,i+nres))
5666 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5667 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5671 dXX_Ctab(k,i)=dXX_Ci(k)
5672 dXX_C1tab(k,i)=dXX_Ci1(k)
5673 dYY_Ctab(k,i)=dYY_Ci(k)
5674 dYY_C1tab(k,i)=dYY_Ci1(k)
5675 dZZ_Ctab(k,i)=dZZ_Ci(k)
5676 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5677 dXX_XYZtab(k,i)=dXX_XYZ(k)
5678 dYY_XYZtab(k,i)=dYY_XYZ(k)
5679 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5683 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5684 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5685 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5686 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5687 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5689 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5690 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5691 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5692 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5693 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5694 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5695 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5696 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5698 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5699 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5701 C to check gradient call subroutine check_grad
5707 c------------------------------------------------------------------------------
5708 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5710 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5711 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5712 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5713 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5715 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5716 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5718 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5719 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5720 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5721 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5722 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5724 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5725 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5726 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5727 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5728 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5730 dsc_i = 0.743d0+x(61)
5732 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5733 & *(xx*cost2+yy*sint2))
5734 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5735 & *(xx*cost2-yy*sint2))
5736 s1=(1+x(63))/(0.1d0 + dscp1)
5737 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5738 s2=(1+x(65))/(0.1d0 + dscp2)
5739 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5740 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5741 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5746 c------------------------------------------------------------------------------
5747 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5749 C This procedure calculates two-body contact function g(rij) and its derivative:
5752 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5755 C where x=(rij-r0ij)/delta
5757 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5760 double precision rij,r0ij,eps0ij,fcont,fprimcont
5761 double precision x,x2,x4,delta
5765 if (x.lt.-1.0D0) then
5768 else if (x.le.1.0D0) then
5771 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5772 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5779 c------------------------------------------------------------------------------
5780 subroutine splinthet(theti,delta,ss,ssder)
5781 implicit real*8 (a-h,o-z)
5782 include 'DIMENSIONS'
5783 include 'COMMON.VAR'
5784 include 'COMMON.GEO'
5787 if (theti.gt.pipol) then
5788 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5790 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5795 c------------------------------------------------------------------------------
5796 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5798 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5799 double precision ksi,ksi2,ksi3,a1,a2,a3
5800 a1=fprim0*delta/(f1-f0)
5806 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5807 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5810 c------------------------------------------------------------------------------
5811 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5813 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5814 double precision ksi,ksi2,ksi3,a1,a2,a3
5819 a2=3*(f1x-f0x)-2*fprim0x*delta
5820 a3=fprim0x*delta-2*(f1x-f0x)
5821 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5824 C-----------------------------------------------------------------------------
5826 C-----------------------------------------------------------------------------
5827 subroutine etor(etors,edihcnstr)
5828 implicit real*8 (a-h,o-z)
5829 include 'DIMENSIONS'
5830 include 'COMMON.VAR'
5831 include 'COMMON.GEO'
5832 include 'COMMON.LOCAL'
5833 include 'COMMON.TORSION'
5834 include 'COMMON.INTERACT'
5835 include 'COMMON.DERIV'
5836 include 'COMMON.CHAIN'
5837 include 'COMMON.NAMES'
5838 include 'COMMON.IOUNITS'
5839 include 'COMMON.FFIELD'
5840 include 'COMMON.TORCNSTR'
5841 include 'COMMON.CONTROL'
5843 C Set lprn=.true. for debugging
5847 do i=iphi_start,iphi_end
5849 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5850 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5851 itori=itortyp(itype(i-2))
5852 itori1=itortyp(itype(i-1))
5855 C Proline-Proline pair is a special case...
5856 if (itori.eq.3 .and. itori1.eq.3) then
5857 if (phii.gt.-dwapi3) then
5859 fac=1.0D0/(1.0D0-cosphi)
5860 etorsi=v1(1,3,3)*fac
5861 etorsi=etorsi+etorsi
5862 etors=etors+etorsi-v1(1,3,3)
5863 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5864 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5867 v1ij=v1(j+1,itori,itori1)
5868 v2ij=v2(j+1,itori,itori1)
5871 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5872 if (energy_dec) etors_ii=etors_ii+
5873 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5874 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5878 v1ij=v1(j,itori,itori1)
5879 v2ij=v2(j,itori,itori1)
5882 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5883 if (energy_dec) etors_ii=etors_ii+
5884 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5885 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5888 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5891 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5892 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5893 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5894 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5895 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5897 ! 6/20/98 - dihedral angle constraints
5900 itori=idih_constr(i)
5903 if (difi.gt.drange(i)) then
5905 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5906 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5907 else if (difi.lt.-drange(i)) then
5909 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5910 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5912 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5913 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5915 ! write (iout,*) 'edihcnstr',edihcnstr
5918 c------------------------------------------------------------------------------
5919 subroutine etor_d(etors_d)
5923 c----------------------------------------------------------------------------
5925 subroutine etor(etors,edihcnstr)
5926 implicit real*8 (a-h,o-z)
5927 include 'DIMENSIONS'
5928 include 'COMMON.VAR'
5929 include 'COMMON.GEO'
5930 include 'COMMON.LOCAL'
5931 include 'COMMON.TORSION'
5932 include 'COMMON.INTERACT'
5933 include 'COMMON.DERIV'
5934 include 'COMMON.CHAIN'
5935 include 'COMMON.NAMES'
5936 include 'COMMON.IOUNITS'
5937 include 'COMMON.FFIELD'
5938 include 'COMMON.TORCNSTR'
5939 include 'COMMON.CONTROL'
5941 C Set lprn=.true. for debugging
5945 do i=iphi_start,iphi_end
5946 C ANY TWO ARE DUMMY ATOMS in row CYCLE
5947 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
5948 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
5949 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
5950 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5951 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5952 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
5953 C For introducing the NH3+ and COO- group please check the etor_d for reference
5956 if (iabs(itype(i)).eq.20) then
5961 itori=itortyp(itype(i-2))
5962 itori1=itortyp(itype(i-1))
5965 C Regular cosine and sine terms
5966 do j=1,nterm(itori,itori1,iblock)
5967 v1ij=v1(j,itori,itori1,iblock)
5968 v2ij=v2(j,itori,itori1,iblock)
5971 etors=etors+v1ij*cosphi+v2ij*sinphi
5972 if (energy_dec) etors_ii=etors_ii+
5973 & v1ij*cosphi+v2ij*sinphi
5974 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5978 C E = SUM ----------------------------------- - v1
5979 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5981 cosphi=dcos(0.5d0*phii)
5982 sinphi=dsin(0.5d0*phii)
5983 do j=1,nlor(itori,itori1,iblock)
5984 vl1ij=vlor1(j,itori,itori1)
5985 vl2ij=vlor2(j,itori,itori1)
5986 vl3ij=vlor3(j,itori,itori1)
5987 pom=vl2ij*cosphi+vl3ij*sinphi
5988 pom1=1.0d0/(pom*pom+1.0d0)
5989 etors=etors+vl1ij*pom1
5990 if (energy_dec) etors_ii=etors_ii+
5993 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5995 C Subtract the constant term
5996 etors=etors-v0(itori,itori1,iblock)
5997 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5998 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6000 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6001 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6002 & (v1(j,itori,itori1,iblock),j=1,6),
6003 & (v2(j,itori,itori1,iblock),j=1,6)
6004 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6005 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6007 ! 6/20/98 - dihedral angle constraints
6009 c do i=1,ndih_constr
6010 do i=idihconstr_start,idihconstr_end
6011 itori=idih_constr(i)
6013 difi=pinorm(phii-phi0(i))
6014 if (difi.gt.drange(i)) then
6016 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6017 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6018 else if (difi.lt.-drange(i)) then
6020 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6021 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6025 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6026 cd & rad2deg*phi0(i), rad2deg*drange(i),
6027 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6029 cd write (iout,*) 'edihcnstr',edihcnstr
6032 c----------------------------------------------------------------------------
6033 subroutine etor_d(etors_d)
6034 C 6/23/01 Compute double torsional energy
6035 implicit real*8 (a-h,o-z)
6036 include 'DIMENSIONS'
6037 include 'COMMON.VAR'
6038 include 'COMMON.GEO'
6039 include 'COMMON.LOCAL'
6040 include 'COMMON.TORSION'
6041 include 'COMMON.INTERACT'
6042 include 'COMMON.DERIV'
6043 include 'COMMON.CHAIN'
6044 include 'COMMON.NAMES'
6045 include 'COMMON.IOUNITS'
6046 include 'COMMON.FFIELD'
6047 include 'COMMON.TORCNSTR'
6049 C Set lprn=.true. for debugging
6053 c write(iout,*) "a tu??"
6054 do i=iphid_start,iphid_end
6055 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6056 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6057 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6058 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6059 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6060 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6061 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6062 & (itype(i+1).eq.ntyp1)) cycle
6063 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6064 itori=itortyp(itype(i-2))
6065 itori1=itortyp(itype(i-1))
6066 itori2=itortyp(itype(i))
6072 if (iabs(itype(i+1)).eq.20) iblock=2
6073 C Iblock=2 Proline type
6074 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6075 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6076 C if (itype(i+1).eq.ntyp1) iblock=3
6077 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6078 C IS or IS NOT need for this
6079 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6080 C is (itype(i-3).eq.ntyp1) ntblock=2
6081 C ntblock is N-terminal blocking group
6083 C Regular cosine and sine terms
6084 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6085 C Example of changes for NH3+ blocking group
6086 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6087 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6088 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6089 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6090 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6091 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6092 cosphi1=dcos(j*phii)
6093 sinphi1=dsin(j*phii)
6094 cosphi2=dcos(j*phii1)
6095 sinphi2=dsin(j*phii1)
6096 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6097 & v2cij*cosphi2+v2sij*sinphi2
6098 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6099 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6101 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6103 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6104 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6105 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6106 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6107 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6108 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6109 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6110 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6111 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6112 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6113 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6114 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6115 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6116 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6119 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6120 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6125 c------------------------------------------------------------------------------
6126 subroutine eback_sc_corr(esccor)
6127 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6128 c conformational states; temporarily implemented as differences
6129 c between UNRES torsional potentials (dependent on three types of
6130 c residues) and the torsional potentials dependent on all 20 types
6131 c of residues computed from AM1 energy surfaces of terminally-blocked
6132 c amino-acid residues.
6133 implicit real*8 (a-h,o-z)
6134 include 'DIMENSIONS'
6135 include 'COMMON.VAR'
6136 include 'COMMON.GEO'
6137 include 'COMMON.LOCAL'
6138 include 'COMMON.TORSION'
6139 include 'COMMON.SCCOR'
6140 include 'COMMON.INTERACT'
6141 include 'COMMON.DERIV'
6142 include 'COMMON.CHAIN'
6143 include 'COMMON.NAMES'
6144 include 'COMMON.IOUNITS'
6145 include 'COMMON.FFIELD'
6146 include 'COMMON.CONTROL'
6148 C Set lprn=.true. for debugging
6151 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6153 do i=itau_start,itau_end
6154 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6156 isccori=isccortyp(itype(i-2))
6157 isccori1=isccortyp(itype(i-1))
6158 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6160 do intertyp=1,3 !intertyp
6161 cc Added 09 May 2012 (Adasko)
6162 cc Intertyp means interaction type of backbone mainchain correlation:
6163 c 1 = SC...Ca...Ca...Ca
6164 c 2 = Ca...Ca...Ca...SC
6165 c 3 = SC...Ca...Ca...SCi
6167 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6168 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6169 & (itype(i-1).eq.ntyp1)))
6170 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6171 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6172 & .or.(itype(i).eq.ntyp1)))
6173 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6174 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6175 & (itype(i-3).eq.ntyp1)))) cycle
6176 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6177 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6179 do j=1,nterm_sccor(isccori,isccori1)
6180 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6181 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6182 cosphi=dcos(j*tauangle(intertyp,i))
6183 sinphi=dsin(j*tauangle(intertyp,i))
6184 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6185 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6187 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6188 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6190 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6191 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6192 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6193 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6194 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6200 c----------------------------------------------------------------------------
6201 subroutine multibody(ecorr)
6202 C This subroutine calculates multi-body contributions to energy following
6203 C the idea of Skolnick et al. If side chains I and J make a contact and
6204 C at the same time side chains I+1 and J+1 make a contact, an extra
6205 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6206 implicit real*8 (a-h,o-z)
6207 include 'DIMENSIONS'
6208 include 'COMMON.IOUNITS'
6209 include 'COMMON.DERIV'
6210 include 'COMMON.INTERACT'
6211 include 'COMMON.CONTACTS'
6212 double precision gx(3),gx1(3)
6215 C Set lprn=.true. for debugging
6219 write (iout,'(a)') 'Contact function values:'
6221 write (iout,'(i2,20(1x,i2,f10.5))')
6222 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6237 num_conti=num_cont(i)
6238 num_conti1=num_cont(i1)
6243 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6244 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6245 cd & ' ishift=',ishift
6246 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6247 C The system gains extra energy.
6248 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6249 endif ! j1==j+-ishift
6258 c------------------------------------------------------------------------------
6259 double precision function esccorr(i,j,k,l,jj,kk)
6260 implicit real*8 (a-h,o-z)
6261 include 'DIMENSIONS'
6262 include 'COMMON.IOUNITS'
6263 include 'COMMON.DERIV'
6264 include 'COMMON.INTERACT'
6265 include 'COMMON.CONTACTS'
6266 double precision gx(3),gx1(3)
6271 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6272 C Calculate the multi-body contribution to energy.
6273 C Calculate multi-body contributions to the gradient.
6274 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6275 cd & k,l,(gacont(m,kk,k),m=1,3)
6277 gx(m) =ekl*gacont(m,jj,i)
6278 gx1(m)=eij*gacont(m,kk,k)
6279 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6280 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6281 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6282 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6286 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6291 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6297 c------------------------------------------------------------------------------
6298 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6299 C This subroutine calculates multi-body contributions to hydrogen-bonding
6300 implicit real*8 (a-h,o-z)
6301 include 'DIMENSIONS'
6302 include 'COMMON.IOUNITS'
6305 parameter (max_cont=maxconts)
6306 parameter (max_dim=26)
6307 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6308 double precision zapas(max_dim,maxconts,max_fg_procs),
6309 & zapas_recv(max_dim,maxconts,max_fg_procs)
6310 common /przechowalnia/ zapas
6311 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6312 & status_array(MPI_STATUS_SIZE,maxconts*2)
6314 include 'COMMON.SETUP'
6315 include 'COMMON.FFIELD'
6316 include 'COMMON.DERIV'
6317 include 'COMMON.INTERACT'
6318 include 'COMMON.CONTACTS'
6319 include 'COMMON.CONTROL'
6320 include 'COMMON.LOCAL'
6321 double precision gx(3),gx1(3),time00
6324 C Set lprn=.true. for debugging
6329 if (nfgtasks.le.1) goto 30
6331 write (iout,'(a)') 'Contact function values before RECEIVE:'
6333 write (iout,'(2i3,50(1x,i2,f5.2))')
6334 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6335 & j=1,num_cont_hb(i))
6339 do i=1,ntask_cont_from
6342 do i=1,ntask_cont_to
6345 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6347 C Make the list of contacts to send to send to other procesors
6348 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6350 do i=iturn3_start,iturn3_end
6351 c write (iout,*) "make contact list turn3",i," num_cont",
6353 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6355 do i=iturn4_start,iturn4_end
6356 c write (iout,*) "make contact list turn4",i," num_cont",
6358 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6362 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6364 do j=1,num_cont_hb(i)
6367 iproc=iint_sent_local(k,jjc,ii)
6368 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6369 if (iproc.gt.0) then
6370 ncont_sent(iproc)=ncont_sent(iproc)+1
6371 nn=ncont_sent(iproc)
6373 zapas(2,nn,iproc)=jjc
6374 zapas(3,nn,iproc)=facont_hb(j,i)
6375 zapas(4,nn,iproc)=ees0p(j,i)
6376 zapas(5,nn,iproc)=ees0m(j,i)
6377 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6378 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6379 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6380 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6381 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6382 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6383 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6384 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6385 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6386 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6387 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6388 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6389 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6390 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6391 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6392 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6393 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6394 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6395 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6396 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6397 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6404 & "Numbers of contacts to be sent to other processors",
6405 & (ncont_sent(i),i=1,ntask_cont_to)
6406 write (iout,*) "Contacts sent"
6407 do ii=1,ntask_cont_to
6409 iproc=itask_cont_to(ii)
6410 write (iout,*) nn," contacts to processor",iproc,
6411 & " of CONT_TO_COMM group"
6413 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6421 CorrelID1=nfgtasks+fg_rank+1
6423 C Receive the numbers of needed contacts from other processors
6424 do ii=1,ntask_cont_from
6425 iproc=itask_cont_from(ii)
6427 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6428 & FG_COMM,req(ireq),IERR)
6430 c write (iout,*) "IRECV ended"
6432 C Send the number of contacts needed by other processors
6433 do ii=1,ntask_cont_to
6434 iproc=itask_cont_to(ii)
6436 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6437 & FG_COMM,req(ireq),IERR)
6439 c write (iout,*) "ISEND ended"
6440 c write (iout,*) "number of requests (nn)",ireq
6443 & call MPI_Waitall(ireq,req,status_array,ierr)
6445 c & "Numbers of contacts to be received from other processors",
6446 c & (ncont_recv(i),i=1,ntask_cont_from)
6450 do ii=1,ntask_cont_from
6451 iproc=itask_cont_from(ii)
6453 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6454 c & " of CONT_TO_COMM group"
6458 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6459 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6460 c write (iout,*) "ireq,req",ireq,req(ireq)
6463 C Send the contacts to processors that need them
6464 do ii=1,ntask_cont_to
6465 iproc=itask_cont_to(ii)
6467 c write (iout,*) nn," contacts to processor",iproc,
6468 c & " of CONT_TO_COMM group"
6471 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6472 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6473 c write (iout,*) "ireq,req",ireq,req(ireq)
6475 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6479 c write (iout,*) "number of requests (contacts)",ireq
6480 c write (iout,*) "req",(req(i),i=1,4)
6483 & call MPI_Waitall(ireq,req,status_array,ierr)
6484 do iii=1,ntask_cont_from
6485 iproc=itask_cont_from(iii)
6488 write (iout,*) "Received",nn," contacts from processor",iproc,
6489 & " of CONT_FROM_COMM group"
6492 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6497 ii=zapas_recv(1,i,iii)
6498 c Flag the received contacts to prevent double-counting
6499 jj=-zapas_recv(2,i,iii)
6500 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6502 nnn=num_cont_hb(ii)+1
6505 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6506 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6507 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6508 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6509 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6510 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6511 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6512 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6513 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6514 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6515 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6516 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6517 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6518 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6519 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6520 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6521 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6522 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6523 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6524 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6525 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6526 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6527 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6528 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6533 write (iout,'(a)') 'Contact function values after receive:'
6535 write (iout,'(2i3,50(1x,i3,f5.2))')
6536 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6537 & j=1,num_cont_hb(i))
6544 write (iout,'(a)') 'Contact function values:'
6546 write (iout,'(2i3,50(1x,i3,f5.2))')
6547 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6548 & j=1,num_cont_hb(i))
6552 C Remove the loop below after debugging !!!
6559 C Calculate the local-electrostatic correlation terms
6560 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6562 num_conti=num_cont_hb(i)
6563 num_conti1=num_cont_hb(i+1)
6570 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6571 c & ' jj=',jj,' kk=',kk
6572 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6573 & .or. j.lt.0 .and. j1.gt.0) .and.
6574 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6575 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6576 C The system gains extra energy.
6577 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6578 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6579 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6581 else if (j1.eq.j) then
6582 C Contacts I-J and I-(J+1) occur simultaneously.
6583 C The system loses extra energy.
6584 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6589 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6590 c & ' jj=',jj,' kk=',kk
6592 C Contacts I-J and (I+1)-J occur simultaneously.
6593 C The system loses extra energy.
6594 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6601 c------------------------------------------------------------------------------
6602 subroutine add_hb_contact(ii,jj,itask)
6603 implicit real*8 (a-h,o-z)
6604 include "DIMENSIONS"
6605 include "COMMON.IOUNITS"
6608 parameter (max_cont=maxconts)
6609 parameter (max_dim=26)
6610 include "COMMON.CONTACTS"
6611 double precision zapas(max_dim,maxconts,max_fg_procs),
6612 & zapas_recv(max_dim,maxconts,max_fg_procs)
6613 common /przechowalnia/ zapas
6614 integer i,j,ii,jj,iproc,itask(4),nn
6615 c write (iout,*) "itask",itask
6618 if (iproc.gt.0) then
6619 do j=1,num_cont_hb(ii)
6621 c write (iout,*) "i",ii," j",jj," jjc",jjc
6623 ncont_sent(iproc)=ncont_sent(iproc)+1
6624 nn=ncont_sent(iproc)
6625 zapas(1,nn,iproc)=ii
6626 zapas(2,nn,iproc)=jjc
6627 zapas(3,nn,iproc)=facont_hb(j,ii)
6628 zapas(4,nn,iproc)=ees0p(j,ii)
6629 zapas(5,nn,iproc)=ees0m(j,ii)
6630 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6631 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6632 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6633 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6634 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6635 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6636 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6637 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6638 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6639 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6640 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6641 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6642 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6643 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6644 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6645 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6646 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6647 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6648 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6649 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6650 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6658 c------------------------------------------------------------------------------
6659 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6661 C This subroutine calculates multi-body contributions to hydrogen-bonding
6662 implicit real*8 (a-h,o-z)
6663 include 'DIMENSIONS'
6664 include 'COMMON.IOUNITS'
6667 parameter (max_cont=maxconts)
6668 parameter (max_dim=70)
6669 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6670 double precision zapas(max_dim,maxconts,max_fg_procs),
6671 & zapas_recv(max_dim,maxconts,max_fg_procs)
6672 common /przechowalnia/ zapas
6673 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6674 & status_array(MPI_STATUS_SIZE,maxconts*2)
6676 include 'COMMON.SETUP'
6677 include 'COMMON.FFIELD'
6678 include 'COMMON.DERIV'
6679 include 'COMMON.LOCAL'
6680 include 'COMMON.INTERACT'
6681 include 'COMMON.CONTACTS'
6682 include 'COMMON.CHAIN'
6683 include 'COMMON.CONTROL'
6684 double precision gx(3),gx1(3)
6685 integer num_cont_hb_old(maxres)
6687 double precision eello4,eello5,eelo6,eello_turn6
6688 external eello4,eello5,eello6,eello_turn6
6689 C Set lprn=.true. for debugging
6694 num_cont_hb_old(i)=num_cont_hb(i)
6698 if (nfgtasks.le.1) goto 30
6700 write (iout,'(a)') 'Contact function values before RECEIVE:'
6702 write (iout,'(2i3,50(1x,i2,f5.2))')
6703 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6704 & j=1,num_cont_hb(i))
6708 do i=1,ntask_cont_from
6711 do i=1,ntask_cont_to
6714 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6716 C Make the list of contacts to send to send to other procesors
6717 do i=iturn3_start,iturn3_end
6718 c write (iout,*) "make contact list turn3",i," num_cont",
6720 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6722 do i=iturn4_start,iturn4_end
6723 c write (iout,*) "make contact list turn4",i," num_cont",
6725 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6729 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6731 do j=1,num_cont_hb(i)
6734 iproc=iint_sent_local(k,jjc,ii)
6735 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6736 if (iproc.ne.0) then
6737 ncont_sent(iproc)=ncont_sent(iproc)+1
6738 nn=ncont_sent(iproc)
6740 zapas(2,nn,iproc)=jjc
6741 zapas(3,nn,iproc)=d_cont(j,i)
6745 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6750 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6758 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6769 & "Numbers of contacts to be sent to other processors",
6770 & (ncont_sent(i),i=1,ntask_cont_to)
6771 write (iout,*) "Contacts sent"
6772 do ii=1,ntask_cont_to
6774 iproc=itask_cont_to(ii)
6775 write (iout,*) nn," contacts to processor",iproc,
6776 & " of CONT_TO_COMM group"
6778 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6786 CorrelID1=nfgtasks+fg_rank+1
6788 C Receive the numbers of needed contacts from other processors
6789 do ii=1,ntask_cont_from
6790 iproc=itask_cont_from(ii)
6792 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6793 & FG_COMM,req(ireq),IERR)
6795 c write (iout,*) "IRECV ended"
6797 C Send the number of contacts needed by other processors
6798 do ii=1,ntask_cont_to
6799 iproc=itask_cont_to(ii)
6801 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6802 & FG_COMM,req(ireq),IERR)
6804 c write (iout,*) "ISEND ended"
6805 c write (iout,*) "number of requests (nn)",ireq
6808 & call MPI_Waitall(ireq,req,status_array,ierr)
6810 c & "Numbers of contacts to be received from other processors",
6811 c & (ncont_recv(i),i=1,ntask_cont_from)
6815 do ii=1,ntask_cont_from
6816 iproc=itask_cont_from(ii)
6818 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6819 c & " of CONT_TO_COMM group"
6823 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6824 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6825 c write (iout,*) "ireq,req",ireq,req(ireq)
6828 C Send the contacts to processors that need them
6829 do ii=1,ntask_cont_to
6830 iproc=itask_cont_to(ii)
6832 c write (iout,*) nn," contacts to processor",iproc,
6833 c & " of CONT_TO_COMM group"
6836 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6837 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6838 c write (iout,*) "ireq,req",ireq,req(ireq)
6840 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6844 c write (iout,*) "number of requests (contacts)",ireq
6845 c write (iout,*) "req",(req(i),i=1,4)
6848 & call MPI_Waitall(ireq,req,status_array,ierr)
6849 do iii=1,ntask_cont_from
6850 iproc=itask_cont_from(iii)
6853 write (iout,*) "Received",nn," contacts from processor",iproc,
6854 & " of CONT_FROM_COMM group"
6857 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6862 ii=zapas_recv(1,i,iii)
6863 c Flag the received contacts to prevent double-counting
6864 jj=-zapas_recv(2,i,iii)
6865 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6867 nnn=num_cont_hb(ii)+1
6870 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6874 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6879 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6887 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6896 write (iout,'(a)') 'Contact function values after receive:'
6898 write (iout,'(2i3,50(1x,i3,5f6.3))')
6899 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6900 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6907 write (iout,'(a)') 'Contact function values:'
6909 write (iout,'(2i3,50(1x,i2,5f6.3))')
6910 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6911 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6917 C Remove the loop below after debugging !!!
6924 C Calculate the dipole-dipole interaction energies
6925 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6926 do i=iatel_s,iatel_e+1
6927 num_conti=num_cont_hb(i)
6936 C Calculate the local-electrostatic correlation terms
6937 c write (iout,*) "gradcorr5 in eello5 before loop"
6939 c write (iout,'(i5,3f10.5)')
6940 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6942 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6943 c write (iout,*) "corr loop i",i
6945 num_conti=num_cont_hb(i)
6946 num_conti1=num_cont_hb(i+1)
6953 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6954 c & ' jj=',jj,' kk=',kk
6955 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6956 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6957 & .or. j.lt.0 .and. j1.gt.0) .and.
6958 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6959 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6960 C The system gains extra energy.
6962 sqd1=dsqrt(d_cont(jj,i))
6963 sqd2=dsqrt(d_cont(kk,i1))
6964 sred_geom = sqd1*sqd2
6965 IF (sred_geom.lt.cutoff_corr) THEN
6966 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6968 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6969 cd & ' jj=',jj,' kk=',kk
6970 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6971 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6973 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6974 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6977 cd write (iout,*) 'sred_geom=',sred_geom,
6978 cd & ' ekont=',ekont,' fprim=',fprimcont,
6979 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6980 cd write (iout,*) "g_contij",g_contij
6981 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6982 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6983 call calc_eello(i,jp,i+1,jp1,jj,kk)
6984 if (wcorr4.gt.0.0d0)
6985 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6986 if (energy_dec.and.wcorr4.gt.0.0d0)
6987 1 write (iout,'(a6,4i5,0pf7.3)')
6988 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6989 c write (iout,*) "gradcorr5 before eello5"
6991 c write (iout,'(i5,3f10.5)')
6992 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6994 if (wcorr5.gt.0.0d0)
6995 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6996 c write (iout,*) "gradcorr5 after eello5"
6998 c write (iout,'(i5,3f10.5)')
6999 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7001 if (energy_dec.and.wcorr5.gt.0.0d0)
7002 1 write (iout,'(a6,4i5,0pf7.3)')
7003 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7004 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7005 cd write(2,*)'ijkl',i,jp,i+1,jp1
7006 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7007 & .or. wturn6.eq.0.0d0))then
7008 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7009 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7010 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7011 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7012 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7013 cd & 'ecorr6=',ecorr6
7014 cd write (iout,'(4e15.5)') sred_geom,
7015 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7016 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7017 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7018 else if (wturn6.gt.0.0d0
7019 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7020 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7021 eturn6=eturn6+eello_turn6(i,jj,kk)
7022 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7023 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7024 cd write (2,*) 'multibody_eello:eturn6',eturn6
7033 num_cont_hb(i)=num_cont_hb_old(i)
7035 c write (iout,*) "gradcorr5 in eello5"
7037 c write (iout,'(i5,3f10.5)')
7038 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7042 c------------------------------------------------------------------------------
7043 subroutine add_hb_contact_eello(ii,jj,itask)
7044 implicit real*8 (a-h,o-z)
7045 include "DIMENSIONS"
7046 include "COMMON.IOUNITS"
7049 parameter (max_cont=maxconts)
7050 parameter (max_dim=70)
7051 include "COMMON.CONTACTS"
7052 double precision zapas(max_dim,maxconts,max_fg_procs),
7053 & zapas_recv(max_dim,maxconts,max_fg_procs)
7054 common /przechowalnia/ zapas
7055 integer i,j,ii,jj,iproc,itask(4),nn
7056 c write (iout,*) "itask",itask
7059 if (iproc.gt.0) then
7060 do j=1,num_cont_hb(ii)
7062 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7064 ncont_sent(iproc)=ncont_sent(iproc)+1
7065 nn=ncont_sent(iproc)
7066 zapas(1,nn,iproc)=ii
7067 zapas(2,nn,iproc)=jjc
7068 zapas(3,nn,iproc)=d_cont(j,ii)
7072 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7077 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7085 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7097 c------------------------------------------------------------------------------
7098 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7099 implicit real*8 (a-h,o-z)
7100 include 'DIMENSIONS'
7101 include 'COMMON.IOUNITS'
7102 include 'COMMON.DERIV'
7103 include 'COMMON.INTERACT'
7104 include 'COMMON.CONTACTS'
7105 double precision gx(3),gx1(3)
7115 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7116 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7117 C Following 4 lines for diagnostics.
7122 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7123 c & 'Contacts ',i,j,
7124 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7125 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7127 C Calculate the multi-body contribution to energy.
7128 c ecorr=ecorr+ekont*ees
7129 C Calculate multi-body contributions to the gradient.
7130 coeffpees0pij=coeffp*ees0pij
7131 coeffmees0mij=coeffm*ees0mij
7132 coeffpees0pkl=coeffp*ees0pkl
7133 coeffmees0mkl=coeffm*ees0mkl
7135 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7136 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7137 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7138 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7139 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7140 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7141 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7142 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7143 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7144 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7145 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7146 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7147 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7148 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7149 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7150 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7151 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7152 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7153 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7154 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7155 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7156 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7157 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7158 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7159 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7164 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7165 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7166 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7167 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7172 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7173 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7174 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7175 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7178 c write (iout,*) "ehbcorr",ekont*ees
7183 C---------------------------------------------------------------------------
7184 subroutine dipole(i,j,jj)
7185 implicit real*8 (a-h,o-z)
7186 include 'DIMENSIONS'
7187 include 'COMMON.IOUNITS'
7188 include 'COMMON.CHAIN'
7189 include 'COMMON.FFIELD'
7190 include 'COMMON.DERIV'
7191 include 'COMMON.INTERACT'
7192 include 'COMMON.CONTACTS'
7193 include 'COMMON.TORSION'
7194 include 'COMMON.VAR'
7195 include 'COMMON.GEO'
7196 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7198 iti1 = itortyp(itype(i+1))
7199 if (j.lt.nres-1) then
7200 itj1 = itortyp(itype(j+1))
7205 dipi(iii,1)=Ub2(iii,i)
7206 dipderi(iii)=Ub2der(iii,i)
7207 dipi(iii,2)=b1(iii,iti1)
7208 dipj(iii,1)=Ub2(iii,j)
7209 dipderj(iii)=Ub2der(iii,j)
7210 dipj(iii,2)=b1(iii,itj1)
7214 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7217 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7224 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7228 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7233 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7234 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7236 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7238 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7240 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7245 C---------------------------------------------------------------------------
7246 subroutine calc_eello(i,j,k,l,jj,kk)
7248 C This subroutine computes matrices and vectors needed to calculate
7249 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7251 implicit real*8 (a-h,o-z)
7252 include 'DIMENSIONS'
7253 include 'COMMON.IOUNITS'
7254 include 'COMMON.CHAIN'
7255 include 'COMMON.DERIV'
7256 include 'COMMON.INTERACT'
7257 include 'COMMON.CONTACTS'
7258 include 'COMMON.TORSION'
7259 include 'COMMON.VAR'
7260 include 'COMMON.GEO'
7261 include 'COMMON.FFIELD'
7262 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7263 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7266 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7267 cd & ' jj=',jj,' kk=',kk
7268 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7269 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7270 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7273 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7274 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7277 call transpose2(aa1(1,1),aa1t(1,1))
7278 call transpose2(aa2(1,1),aa2t(1,1))
7281 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7282 & aa1tder(1,1,lll,kkk))
7283 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7284 & aa2tder(1,1,lll,kkk))
7288 C parallel orientation of the two CA-CA-CA frames.
7290 iti=itortyp(itype(i))
7294 itk1=itortyp(itype(k+1))
7295 itj=itortyp(itype(j))
7296 if (l.lt.nres-1) then
7297 itl1=itortyp(itype(l+1))
7301 C A1 kernel(j+1) A2T
7303 cd write (iout,'(3f10.5,5x,3f10.5)')
7304 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7306 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7307 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7308 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7309 C Following matrices are needed only for 6-th order cumulants
7310 IF (wcorr6.gt.0.0d0) THEN
7311 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7312 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7313 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7314 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7315 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7316 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7317 & ADtEAderx(1,1,1,1,1,1))
7319 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7320 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7321 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7322 & ADtEA1derx(1,1,1,1,1,1))
7324 C End 6-th order cumulants
7327 cd write (2,*) 'In calc_eello6'
7329 cd write (2,*) 'iii=',iii
7331 cd write (2,*) 'kkk=',kkk
7333 cd write (2,'(3(2f10.5),5x)')
7334 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7339 call transpose2(EUgder(1,1,k),auxmat(1,1))
7340 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7341 call transpose2(EUg(1,1,k),auxmat(1,1))
7342 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7343 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7347 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7348 & EAEAderx(1,1,lll,kkk,iii,1))
7352 C A1T kernel(i+1) A2
7353 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7354 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7355 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7356 C Following matrices are needed only for 6-th order cumulants
7357 IF (wcorr6.gt.0.0d0) THEN
7358 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7359 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7360 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7361 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7362 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7363 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7364 & ADtEAderx(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.,DtUg2EUg(1,1,k),
7367 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7368 & ADtEA1derx(1,1,1,1,1,2))
7370 C End 6-th order cumulants
7371 call transpose2(EUgder(1,1,l),auxmat(1,1))
7372 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7373 call transpose2(EUg(1,1,l),auxmat(1,1))
7374 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7375 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7379 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7380 & EAEAderx(1,1,lll,kkk,iii,2))
7385 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7386 C They are needed only when the fifth- or the sixth-order cumulants are
7388 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7389 call transpose2(AEA(1,1,1),auxmat(1,1))
7390 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7391 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7392 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7393 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7394 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7395 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7396 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7397 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7398 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7399 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7400 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7401 call transpose2(AEA(1,1,2),auxmat(1,1))
7402 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7403 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7404 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7405 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7406 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7407 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7408 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7409 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7410 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7411 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7412 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7413 C Calculate the Cartesian derivatives of the vectors.
7417 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7418 call matvec2(auxmat(1,1),b1(1,iti),
7419 & AEAb1derx(1,lll,kkk,iii,1,1))
7420 call matvec2(auxmat(1,1),Ub2(1,i),
7421 & AEAb2derx(1,lll,kkk,iii,1,1))
7422 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7423 & AEAb1derx(1,lll,kkk,iii,2,1))
7424 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7425 & AEAb2derx(1,lll,kkk,iii,2,1))
7426 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7427 call matvec2(auxmat(1,1),b1(1,itj),
7428 & AEAb1derx(1,lll,kkk,iii,1,2))
7429 call matvec2(auxmat(1,1),Ub2(1,j),
7430 & AEAb2derx(1,lll,kkk,iii,1,2))
7431 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7432 & AEAb1derx(1,lll,kkk,iii,2,2))
7433 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7434 & AEAb2derx(1,lll,kkk,iii,2,2))
7441 C Antiparallel orientation of the two CA-CA-CA frames.
7443 iti=itortyp(itype(i))
7447 itk1=itortyp(itype(k+1))
7448 itl=itortyp(itype(l))
7449 itj=itortyp(itype(j))
7450 if (j.lt.nres-1) then
7451 itj1=itortyp(itype(j+1))
7455 C A2 kernel(j-1)T A1T
7456 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7457 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7458 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7459 C Following matrices are needed only for 6-th order cumulants
7460 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7461 & j.eq.i+4 .and. l.eq.i+3)) THEN
7462 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7463 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7464 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7465 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7466 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7467 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7468 & ADtEAderx(1,1,1,1,1,1))
7469 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7470 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7471 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7472 & ADtEA1derx(1,1,1,1,1,1))
7474 C End 6-th order cumulants
7475 call transpose2(EUgder(1,1,k),auxmat(1,1))
7476 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7477 call transpose2(EUg(1,1,k),auxmat(1,1))
7478 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7479 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7483 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7484 & EAEAderx(1,1,lll,kkk,iii,1))
7488 C A2T kernel(i+1)T A1
7489 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7490 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7491 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7492 C Following matrices are needed only for 6-th order cumulants
7493 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7494 & j.eq.i+4 .and. l.eq.i+3)) THEN
7495 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7496 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7497 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7498 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7499 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7500 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7501 & ADtEAderx(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.,DtUg2EUg(1,1,k),
7504 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7505 & ADtEA1derx(1,1,1,1,1,2))
7507 C End 6-th order cumulants
7508 call transpose2(EUgder(1,1,j),auxmat(1,1))
7509 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7510 call transpose2(EUg(1,1,j),auxmat(1,1))
7511 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7512 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7516 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7517 & EAEAderx(1,1,lll,kkk,iii,2))
7522 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7523 C They are needed only when the fifth- or the sixth-order cumulants are
7525 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7526 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7527 call transpose2(AEA(1,1,1),auxmat(1,1))
7528 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7529 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7530 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7531 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7532 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7533 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7534 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7535 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7536 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7537 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7538 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7539 call transpose2(AEA(1,1,2),auxmat(1,1))
7540 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7541 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7542 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7543 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7544 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7545 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7546 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7547 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7548 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7549 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7550 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7551 C Calculate the Cartesian derivatives of the vectors.
7555 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7556 call matvec2(auxmat(1,1),b1(1,iti),
7557 & AEAb1derx(1,lll,kkk,iii,1,1))
7558 call matvec2(auxmat(1,1),Ub2(1,i),
7559 & AEAb2derx(1,lll,kkk,iii,1,1))
7560 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7561 & AEAb1derx(1,lll,kkk,iii,2,1))
7562 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7563 & AEAb2derx(1,lll,kkk,iii,2,1))
7564 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7565 call matvec2(auxmat(1,1),b1(1,itl),
7566 & AEAb1derx(1,lll,kkk,iii,1,2))
7567 call matvec2(auxmat(1,1),Ub2(1,l),
7568 & AEAb2derx(1,lll,kkk,iii,1,2))
7569 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7570 & AEAb1derx(1,lll,kkk,iii,2,2))
7571 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7572 & AEAb2derx(1,lll,kkk,iii,2,2))
7581 C---------------------------------------------------------------------------
7582 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7583 & KK,KKderg,AKA,AKAderg,AKAderx)
7587 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7588 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7589 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7594 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7596 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7599 cd if (lprn) write (2,*) 'In kernel'
7601 cd if (lprn) write (2,*) 'kkk=',kkk
7603 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7604 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7606 cd write (2,*) 'lll=',lll
7607 cd write (2,*) 'iii=1'
7609 cd write (2,'(3(2f10.5),5x)')
7610 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7613 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7614 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7616 cd write (2,*) 'lll=',lll
7617 cd write (2,*) 'iii=2'
7619 cd write (2,'(3(2f10.5),5x)')
7620 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7627 C---------------------------------------------------------------------------
7628 double precision function eello4(i,j,k,l,jj,kk)
7629 implicit real*8 (a-h,o-z)
7630 include 'DIMENSIONS'
7631 include 'COMMON.IOUNITS'
7632 include 'COMMON.CHAIN'
7633 include 'COMMON.DERIV'
7634 include 'COMMON.INTERACT'
7635 include 'COMMON.CONTACTS'
7636 include 'COMMON.TORSION'
7637 include 'COMMON.VAR'
7638 include 'COMMON.GEO'
7639 double precision pizda(2,2),ggg1(3),ggg2(3)
7640 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7644 cd print *,'eello4:',i,j,k,l,jj,kk
7645 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7646 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7647 cold eij=facont_hb(jj,i)
7648 cold ekl=facont_hb(kk,k)
7650 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7651 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7652 gcorr_loc(k-1)=gcorr_loc(k-1)
7653 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7655 gcorr_loc(l-1)=gcorr_loc(l-1)
7656 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7658 gcorr_loc(j-1)=gcorr_loc(j-1)
7659 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7664 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7665 & -EAEAderx(2,2,lll,kkk,iii,1)
7666 cd derx(lll,kkk,iii)=0.0d0
7670 cd gcorr_loc(l-1)=0.0d0
7671 cd gcorr_loc(j-1)=0.0d0
7672 cd gcorr_loc(k-1)=0.0d0
7674 cd write (iout,*)'Contacts have occurred for peptide groups',
7675 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7676 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7677 if (j.lt.nres-1) then
7684 if (l.lt.nres-1) then
7692 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7693 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7694 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7695 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7696 cgrad ghalf=0.5d0*ggg1(ll)
7697 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7698 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7699 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7700 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7701 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7702 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7703 cgrad ghalf=0.5d0*ggg2(ll)
7704 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7705 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7706 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7707 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7708 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7709 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7713 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7718 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7723 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7728 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7732 cd write (2,*) iii,gcorr_loc(iii)
7735 cd write (2,*) 'ekont',ekont
7736 cd write (iout,*) 'eello4',ekont*eel4
7739 C---------------------------------------------------------------------------
7740 double precision function eello5(i,j,k,l,jj,kk)
7741 implicit real*8 (a-h,o-z)
7742 include 'DIMENSIONS'
7743 include 'COMMON.IOUNITS'
7744 include 'COMMON.CHAIN'
7745 include 'COMMON.DERIV'
7746 include 'COMMON.INTERACT'
7747 include 'COMMON.CONTACTS'
7748 include 'COMMON.TORSION'
7749 include 'COMMON.VAR'
7750 include 'COMMON.GEO'
7751 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7752 double precision ggg1(3),ggg2(3)
7753 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7758 C /l\ / \ \ / \ / \ / C
7759 C / \ / \ \ / \ / \ / C
7760 C j| o |l1 | o | o| o | | o |o C
7761 C \ |/k\| |/ \| / |/ \| |/ \| C
7762 C \i/ \ / \ / / \ / \ C
7764 C (I) (II) (III) (IV) C
7766 C eello5_1 eello5_2 eello5_3 eello5_4 C
7768 C Antiparallel chains C
7771 C /j\ / \ \ / \ / \ / C
7772 C / \ / \ \ / \ / \ / C
7773 C j1| o |l | o | o| o | | o |o C
7774 C \ |/k\| |/ \| / |/ \| |/ \| C
7775 C \i/ \ / \ / / \ / \ C
7777 C (I) (II) (III) (IV) C
7779 C eello5_1 eello5_2 eello5_3 eello5_4 C
7781 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7783 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7784 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7789 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7791 itk=itortyp(itype(k))
7792 itl=itortyp(itype(l))
7793 itj=itortyp(itype(j))
7798 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7799 cd & eel5_3_num,eel5_4_num)
7803 derx(lll,kkk,iii)=0.0d0
7807 cd eij=facont_hb(jj,i)
7808 cd ekl=facont_hb(kk,k)
7810 cd write (iout,*)'Contacts have occurred for peptide groups',
7811 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7813 C Contribution from the graph I.
7814 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7815 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7816 call transpose2(EUg(1,1,k),auxmat(1,1))
7817 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7818 vv(1)=pizda(1,1)-pizda(2,2)
7819 vv(2)=pizda(1,2)+pizda(2,1)
7820 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7821 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7822 C Explicit gradient in virtual-dihedral angles.
7823 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7824 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7825 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7826 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7827 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7828 vv(1)=pizda(1,1)-pizda(2,2)
7829 vv(2)=pizda(1,2)+pizda(2,1)
7830 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7831 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7832 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7833 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7834 vv(1)=pizda(1,1)-pizda(2,2)
7835 vv(2)=pizda(1,2)+pizda(2,1)
7837 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7838 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7839 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7841 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7842 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7843 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7845 C Cartesian gradient
7849 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7851 vv(1)=pizda(1,1)-pizda(2,2)
7852 vv(2)=pizda(1,2)+pizda(2,1)
7853 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7854 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7855 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7861 C Contribution from graph II
7862 call transpose2(EE(1,1,itk),auxmat(1,1))
7863 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7864 vv(1)=pizda(1,1)+pizda(2,2)
7865 vv(2)=pizda(2,1)-pizda(1,2)
7866 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7867 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7868 C Explicit gradient in virtual-dihedral angles.
7869 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7870 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7871 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7872 vv(1)=pizda(1,1)+pizda(2,2)
7873 vv(2)=pizda(2,1)-pizda(1,2)
7875 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7876 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7877 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7879 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7880 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7881 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7883 C Cartesian gradient
7887 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7889 vv(1)=pizda(1,1)+pizda(2,2)
7890 vv(2)=pizda(2,1)-pizda(1,2)
7891 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7892 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7893 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7901 C Parallel orientation
7902 C Contribution from graph III
7903 call transpose2(EUg(1,1,l),auxmat(1,1))
7904 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7905 vv(1)=pizda(1,1)-pizda(2,2)
7906 vv(2)=pizda(1,2)+pizda(2,1)
7907 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7908 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7909 C Explicit gradient in virtual-dihedral angles.
7910 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7911 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7912 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7913 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7914 vv(1)=pizda(1,1)-pizda(2,2)
7915 vv(2)=pizda(1,2)+pizda(2,1)
7916 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7917 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7918 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7919 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7920 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7921 vv(1)=pizda(1,1)-pizda(2,2)
7922 vv(2)=pizda(1,2)+pizda(2,1)
7923 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7924 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7925 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7926 C Cartesian gradient
7930 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7932 vv(1)=pizda(1,1)-pizda(2,2)
7933 vv(2)=pizda(1,2)+pizda(2,1)
7934 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7935 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7936 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7941 C Contribution from graph IV
7943 call transpose2(EE(1,1,itl),auxmat(1,1))
7944 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7945 vv(1)=pizda(1,1)+pizda(2,2)
7946 vv(2)=pizda(2,1)-pizda(1,2)
7947 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7948 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7949 C Explicit gradient in virtual-dihedral angles.
7950 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7951 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7952 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7953 vv(1)=pizda(1,1)+pizda(2,2)
7954 vv(2)=pizda(2,1)-pizda(1,2)
7955 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7956 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7957 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7958 C Cartesian gradient
7962 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7964 vv(1)=pizda(1,1)+pizda(2,2)
7965 vv(2)=pizda(2,1)-pizda(1,2)
7966 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7967 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7968 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7973 C Antiparallel orientation
7974 C Contribution from graph III
7976 call transpose2(EUg(1,1,j),auxmat(1,1))
7977 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7978 vv(1)=pizda(1,1)-pizda(2,2)
7979 vv(2)=pizda(1,2)+pizda(2,1)
7980 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7981 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7982 C Explicit gradient in virtual-dihedral angles.
7983 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7984 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7985 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7986 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7987 vv(1)=pizda(1,1)-pizda(2,2)
7988 vv(2)=pizda(1,2)+pizda(2,1)
7989 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7990 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7991 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7992 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7993 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7994 vv(1)=pizda(1,1)-pizda(2,2)
7995 vv(2)=pizda(1,2)+pizda(2,1)
7996 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7997 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7998 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7999 C Cartesian gradient
8003 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8005 vv(1)=pizda(1,1)-pizda(2,2)
8006 vv(2)=pizda(1,2)+pizda(2,1)
8007 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8008 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8009 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8014 C Contribution from graph IV
8016 call transpose2(EE(1,1,itj),auxmat(1,1))
8017 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8018 vv(1)=pizda(1,1)+pizda(2,2)
8019 vv(2)=pizda(2,1)-pizda(1,2)
8020 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
8021 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8022 C Explicit gradient in virtual-dihedral angles.
8023 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8024 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8025 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8026 vv(1)=pizda(1,1)+pizda(2,2)
8027 vv(2)=pizda(2,1)-pizda(1,2)
8028 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8029 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
8030 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8031 C Cartesian gradient
8035 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8037 vv(1)=pizda(1,1)+pizda(2,2)
8038 vv(2)=pizda(2,1)-pizda(1,2)
8039 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8040 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
8041 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8047 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8048 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8049 cd write (2,*) 'ijkl',i,j,k,l
8050 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8051 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8053 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8054 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8055 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8056 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8057 if (j.lt.nres-1) then
8064 if (l.lt.nres-1) then
8074 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8075 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8076 C summed up outside the subrouine as for the other subroutines
8077 C handling long-range interactions. The old code is commented out
8078 C with "cgrad" to keep track of changes.
8080 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8081 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8082 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8083 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8084 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8085 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8086 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8087 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8088 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8089 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8091 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8092 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8093 cgrad ghalf=0.5d0*ggg1(ll)
8095 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8096 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8097 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8098 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8099 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8100 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8101 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8102 cgrad ghalf=0.5d0*ggg2(ll)
8104 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8105 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8106 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8107 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8108 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8109 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8114 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8115 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8120 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8121 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8127 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8132 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8136 cd write (2,*) iii,g_corr5_loc(iii)
8139 cd write (2,*) 'ekont',ekont
8140 cd write (iout,*) 'eello5',ekont*eel5
8143 c--------------------------------------------------------------------------
8144 double precision function eello6(i,j,k,l,jj,kk)
8145 implicit real*8 (a-h,o-z)
8146 include 'DIMENSIONS'
8147 include 'COMMON.IOUNITS'
8148 include 'COMMON.CHAIN'
8149 include 'COMMON.DERIV'
8150 include 'COMMON.INTERACT'
8151 include 'COMMON.CONTACTS'
8152 include 'COMMON.TORSION'
8153 include 'COMMON.VAR'
8154 include 'COMMON.GEO'
8155 include 'COMMON.FFIELD'
8156 double precision ggg1(3),ggg2(3)
8157 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8162 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8170 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8171 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8175 derx(lll,kkk,iii)=0.0d0
8179 cd eij=facont_hb(jj,i)
8180 cd ekl=facont_hb(kk,k)
8186 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8187 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8188 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8189 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8190 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8191 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8193 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8194 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8195 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8196 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8197 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8198 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8202 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8204 C If turn contributions are considered, they will be handled separately.
8205 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8206 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8207 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8208 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8209 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8210 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8211 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8213 if (j.lt.nres-1) then
8220 if (l.lt.nres-1) then
8228 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8229 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8230 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8231 cgrad ghalf=0.5d0*ggg1(ll)
8233 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8234 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8235 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8236 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8237 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8238 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8239 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8240 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8241 cgrad ghalf=0.5d0*ggg2(ll)
8242 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8244 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8245 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8246 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8247 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8248 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8249 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8254 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8255 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8260 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8261 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8267 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8272 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8276 cd write (2,*) iii,g_corr6_loc(iii)
8279 cd write (2,*) 'ekont',ekont
8280 cd write (iout,*) 'eello6',ekont*eel6
8283 c--------------------------------------------------------------------------
8284 double precision function eello6_graph1(i,j,k,l,imat,swap)
8285 implicit real*8 (a-h,o-z)
8286 include 'DIMENSIONS'
8287 include 'COMMON.IOUNITS'
8288 include 'COMMON.CHAIN'
8289 include 'COMMON.DERIV'
8290 include 'COMMON.INTERACT'
8291 include 'COMMON.CONTACTS'
8292 include 'COMMON.TORSION'
8293 include 'COMMON.VAR'
8294 include 'COMMON.GEO'
8295 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8299 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8301 C Parallel Antiparallel C
8307 C \ j|/k\| / \ |/k\|l / C
8312 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8313 itk=itortyp(itype(k))
8314 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8315 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8316 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8317 call transpose2(EUgC(1,1,k),auxmat(1,1))
8318 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8319 vv1(1)=pizda1(1,1)-pizda1(2,2)
8320 vv1(2)=pizda1(1,2)+pizda1(2,1)
8321 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8322 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8323 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8324 s5=scalar2(vv(1),Dtobr2(1,i))
8325 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8326 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8327 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8328 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8329 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8330 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8331 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8332 & +scalar2(vv(1),Dtobr2der(1,i)))
8333 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8334 vv1(1)=pizda1(1,1)-pizda1(2,2)
8335 vv1(2)=pizda1(1,2)+pizda1(2,1)
8336 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8337 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8339 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8340 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8341 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8342 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8343 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8345 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8346 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8347 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8348 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8349 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8351 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8352 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8353 vv1(1)=pizda1(1,1)-pizda1(2,2)
8354 vv1(2)=pizda1(1,2)+pizda1(2,1)
8355 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8356 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8357 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8358 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8367 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8368 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8369 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8370 call transpose2(EUgC(1,1,k),auxmat(1,1))
8371 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8373 vv1(1)=pizda1(1,1)-pizda1(2,2)
8374 vv1(2)=pizda1(1,2)+pizda1(2,1)
8375 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8376 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8377 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8378 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8379 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8380 s5=scalar2(vv(1),Dtobr2(1,i))
8381 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8387 c----------------------------------------------------------------------------
8388 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8389 implicit real*8 (a-h,o-z)
8390 include 'DIMENSIONS'
8391 include 'COMMON.IOUNITS'
8392 include 'COMMON.CHAIN'
8393 include 'COMMON.DERIV'
8394 include 'COMMON.INTERACT'
8395 include 'COMMON.CONTACTS'
8396 include 'COMMON.TORSION'
8397 include 'COMMON.VAR'
8398 include 'COMMON.GEO'
8400 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8401 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8404 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8406 C Parallel Antiparallel C
8412 C \ j|/k\| \ |/k\|l C
8417 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8418 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8419 C AL 7/4/01 s1 would occur in the sixth-order moment,
8420 C but not in a cluster cumulant
8422 s1=dip(1,jj,i)*dip(1,kk,k)
8424 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8425 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8426 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8427 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8428 call transpose2(EUg(1,1,k),auxmat(1,1))
8429 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8430 vv(1)=pizda(1,1)-pizda(2,2)
8431 vv(2)=pizda(1,2)+pizda(2,1)
8432 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8433 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8435 eello6_graph2=-(s1+s2+s3+s4)
8437 eello6_graph2=-(s2+s3+s4)
8440 C Derivatives in gamma(i-1)
8443 s1=dipderg(1,jj,i)*dip(1,kk,k)
8445 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8446 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8447 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8448 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8450 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8452 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8454 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8456 C Derivatives in gamma(k-1)
8458 s1=dip(1,jj,i)*dipderg(1,kk,k)
8460 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8461 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8462 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8463 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8464 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8465 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8466 vv(1)=pizda(1,1)-pizda(2,2)
8467 vv(2)=pizda(1,2)+pizda(2,1)
8468 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8470 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8472 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8474 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8475 C Derivatives in gamma(j-1) or gamma(l-1)
8478 s1=dipderg(3,jj,i)*dip(1,kk,k)
8480 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8481 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8482 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8483 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8484 vv(1)=pizda(1,1)-pizda(2,2)
8485 vv(2)=pizda(1,2)+pizda(2,1)
8486 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8489 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8491 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8494 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8495 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8497 C Derivatives in gamma(l-1) or gamma(j-1)
8500 s1=dip(1,jj,i)*dipderg(3,kk,k)
8502 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8503 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8504 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8505 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8506 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8507 vv(1)=pizda(1,1)-pizda(2,2)
8508 vv(2)=pizda(1,2)+pizda(2,1)
8509 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8512 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8514 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8517 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8518 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8520 C Cartesian derivatives.
8522 write (2,*) 'In eello6_graph2'
8524 write (2,*) 'iii=',iii
8526 write (2,*) 'kkk=',kkk
8528 write (2,'(3(2f10.5),5x)')
8529 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8539 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8541 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8544 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8546 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8547 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8549 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8550 call transpose2(EUg(1,1,k),auxmat(1,1))
8551 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8553 vv(1)=pizda(1,1)-pizda(2,2)
8554 vv(2)=pizda(1,2)+pizda(2,1)
8555 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8556 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8558 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8560 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8563 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8565 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8572 c----------------------------------------------------------------------------
8573 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8574 implicit real*8 (a-h,o-z)
8575 include 'DIMENSIONS'
8576 include 'COMMON.IOUNITS'
8577 include 'COMMON.CHAIN'
8578 include 'COMMON.DERIV'
8579 include 'COMMON.INTERACT'
8580 include 'COMMON.CONTACTS'
8581 include 'COMMON.TORSION'
8582 include 'COMMON.VAR'
8583 include 'COMMON.GEO'
8584 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8586 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8588 C Parallel Antiparallel C
8594 C j|/k\| / |/k\|l / C
8599 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8601 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8602 C energy moment and not to the cluster cumulant.
8603 iti=itortyp(itype(i))
8604 if (j.lt.nres-1) then
8605 itj1=itortyp(itype(j+1))
8609 itk=itortyp(itype(k))
8610 itk1=itortyp(itype(k+1))
8611 if (l.lt.nres-1) then
8612 itl1=itortyp(itype(l+1))
8617 s1=dip(4,jj,i)*dip(4,kk,k)
8619 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8620 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8621 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8622 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8623 call transpose2(EE(1,1,itk),auxmat(1,1))
8624 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8625 vv(1)=pizda(1,1)+pizda(2,2)
8626 vv(2)=pizda(2,1)-pizda(1,2)
8627 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8628 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8629 cd & "sum",-(s2+s3+s4)
8631 eello6_graph3=-(s1+s2+s3+s4)
8633 eello6_graph3=-(s2+s3+s4)
8636 C Derivatives in gamma(k-1)
8637 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8638 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8639 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8640 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8641 C Derivatives in gamma(l-1)
8642 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8643 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8644 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8645 vv(1)=pizda(1,1)+pizda(2,2)
8646 vv(2)=pizda(2,1)-pizda(1,2)
8647 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8648 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8649 C Cartesian derivatives.
8655 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8657 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8660 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8662 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8663 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8665 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8666 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8668 vv(1)=pizda(1,1)+pizda(2,2)
8669 vv(2)=pizda(2,1)-pizda(1,2)
8670 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8672 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8674 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8677 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8679 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8681 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8687 c----------------------------------------------------------------------------
8688 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8689 implicit real*8 (a-h,o-z)
8690 include 'DIMENSIONS'
8691 include 'COMMON.IOUNITS'
8692 include 'COMMON.CHAIN'
8693 include 'COMMON.DERIV'
8694 include 'COMMON.INTERACT'
8695 include 'COMMON.CONTACTS'
8696 include 'COMMON.TORSION'
8697 include 'COMMON.VAR'
8698 include 'COMMON.GEO'
8699 include 'COMMON.FFIELD'
8700 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8701 & auxvec1(2),auxmat1(2,2)
8703 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8705 C Parallel Antiparallel C
8711 C \ j|/k\| \ |/k\|l C
8716 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8718 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8719 C energy moment and not to the cluster cumulant.
8720 cd write (2,*) 'eello_graph4: wturn6',wturn6
8721 iti=itortyp(itype(i))
8722 itj=itortyp(itype(j))
8723 if (j.lt.nres-1) then
8724 itj1=itortyp(itype(j+1))
8728 itk=itortyp(itype(k))
8729 if (k.lt.nres-1) then
8730 itk1=itortyp(itype(k+1))
8734 itl=itortyp(itype(l))
8735 if (l.lt.nres-1) then
8736 itl1=itortyp(itype(l+1))
8740 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8741 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8742 cd & ' itl',itl,' itl1',itl1
8745 s1=dip(3,jj,i)*dip(3,kk,k)
8747 s1=dip(2,jj,j)*dip(2,kk,l)
8750 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8751 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8753 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8754 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8756 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8757 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8759 call transpose2(EUg(1,1,k),auxmat(1,1))
8760 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8761 vv(1)=pizda(1,1)-pizda(2,2)
8762 vv(2)=pizda(2,1)+pizda(1,2)
8763 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8764 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8766 eello6_graph4=-(s1+s2+s3+s4)
8768 eello6_graph4=-(s2+s3+s4)
8770 C Derivatives in gamma(i-1)
8774 s1=dipderg(2,jj,i)*dip(3,kk,k)
8776 s1=dipderg(4,jj,j)*dip(2,kk,l)
8779 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8781 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8782 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8784 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8785 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8787 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8788 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8789 cd write (2,*) 'turn6 derivatives'
8791 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8793 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8797 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8799 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8803 C Derivatives in gamma(k-1)
8806 s1=dip(3,jj,i)*dipderg(2,kk,k)
8808 s1=dip(2,jj,j)*dipderg(4,kk,l)
8811 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8812 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8814 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8815 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8817 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8818 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8820 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8821 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8822 vv(1)=pizda(1,1)-pizda(2,2)
8823 vv(2)=pizda(2,1)+pizda(1,2)
8824 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8825 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8827 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8829 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8833 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8835 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8838 C Derivatives in gamma(j-1) or gamma(l-1)
8839 if (l.eq.j+1 .and. l.gt.1) then
8840 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8841 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8842 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8843 vv(1)=pizda(1,1)-pizda(2,2)
8844 vv(2)=pizda(2,1)+pizda(1,2)
8845 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8846 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8847 else if (j.gt.1) then
8848 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8849 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8850 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8851 vv(1)=pizda(1,1)-pizda(2,2)
8852 vv(2)=pizda(2,1)+pizda(1,2)
8853 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8854 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8855 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8857 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8860 C Cartesian derivatives.
8867 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8869 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8873 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8875 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8879 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8881 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8883 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8884 & b1(1,itj1),auxvec(1))
8885 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8887 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8888 & b1(1,itl1),auxvec(1))
8889 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8891 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8893 vv(1)=pizda(1,1)-pizda(2,2)
8894 vv(2)=pizda(2,1)+pizda(1,2)
8895 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8897 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8899 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8902 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8905 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8908 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8910 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8912 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8916 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8918 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8921 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8923 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8931 c----------------------------------------------------------------------------
8932 double precision function eello_turn6(i,jj,kk)
8933 implicit real*8 (a-h,o-z)
8934 include 'DIMENSIONS'
8935 include 'COMMON.IOUNITS'
8936 include 'COMMON.CHAIN'
8937 include 'COMMON.DERIV'
8938 include 'COMMON.INTERACT'
8939 include 'COMMON.CONTACTS'
8940 include 'COMMON.TORSION'
8941 include 'COMMON.VAR'
8942 include 'COMMON.GEO'
8943 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8944 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8946 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8947 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8948 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8949 C the respective energy moment and not to the cluster cumulant.
8958 iti=itortyp(itype(i))
8959 itk=itortyp(itype(k))
8960 itk1=itortyp(itype(k+1))
8961 itl=itortyp(itype(l))
8962 itj=itortyp(itype(j))
8963 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8964 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8965 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8970 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8972 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8976 derx_turn(lll,kkk,iii)=0.0d0
8983 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8985 cd write (2,*) 'eello6_5',eello6_5
8987 call transpose2(AEA(1,1,1),auxmat(1,1))
8988 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8989 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8990 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8992 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8993 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8994 s2 = scalar2(b1(1,itk),vtemp1(1))
8996 call transpose2(AEA(1,1,2),atemp(1,1))
8997 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8998 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8999 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9001 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9002 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9003 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9005 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9006 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9007 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9008 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9009 ss13 = scalar2(b1(1,itk),vtemp4(1))
9010 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9012 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9018 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9019 C Derivatives in gamma(i+2)
9023 call transpose2(AEA(1,1,1),auxmatd(1,1))
9024 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9025 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9026 call transpose2(AEAderg(1,1,2),atempd(1,1))
9027 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9028 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9030 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9031 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9032 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9038 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9039 C Derivatives in gamma(i+3)
9041 call transpose2(AEA(1,1,1),auxmatd(1,1))
9042 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9043 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9044 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9046 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9047 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9048 s2d = scalar2(b1(1,itk),vtemp1d(1))
9050 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9051 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9053 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9055 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9056 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9057 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9065 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9066 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9068 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9069 & -0.5d0*ekont*(s2d+s12d)
9071 C Derivatives in gamma(i+4)
9072 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9073 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9074 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9076 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9077 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9078 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9086 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9088 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9090 C Derivatives in gamma(i+5)
9092 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9093 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9094 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9096 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9097 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9098 s2d = scalar2(b1(1,itk),vtemp1d(1))
9100 call transpose2(AEA(1,1,2),atempd(1,1))
9101 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9102 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9104 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9105 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9107 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9108 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9109 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9117 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9118 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9120 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9121 & -0.5d0*ekont*(s2d+s12d)
9123 C Cartesian derivatives
9128 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9129 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9130 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9132 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9133 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9135 s2d = scalar2(b1(1,itk),vtemp1d(1))
9137 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9138 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9139 s8d = -(atempd(1,1)+atempd(2,2))*
9140 & scalar2(cc(1,1,itl),vtemp2(1))
9142 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9144 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9145 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9152 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9155 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9159 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9160 & - 0.5d0*(s8d+s12d)
9162 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9171 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9173 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9174 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9175 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9176 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9177 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9179 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9180 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9181 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9185 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9186 cd & 16*eel_turn6_num
9188 if (j.lt.nres-1) then
9195 if (l.lt.nres-1) then
9203 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9204 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9205 cgrad ghalf=0.5d0*ggg1(ll)
9207 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9208 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9209 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9210 & +ekont*derx_turn(ll,2,1)
9211 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9212 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9213 & +ekont*derx_turn(ll,4,1)
9214 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9215 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9216 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9217 cgrad ghalf=0.5d0*ggg2(ll)
9219 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9220 & +ekont*derx_turn(ll,2,2)
9221 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9222 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9223 & +ekont*derx_turn(ll,4,2)
9224 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9225 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9226 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9231 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9236 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9242 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9247 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9251 cd write (2,*) iii,g_corr6_loc(iii)
9253 eello_turn6=ekont*eel_turn6
9254 cd write (2,*) 'ekont',ekont
9255 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9259 C-----------------------------------------------------------------------------
9260 double precision function scalar(u,v)
9261 !DIR$ INLINEALWAYS scalar
9263 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9266 double precision u(3),v(3)
9267 cd double precision sc
9275 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9278 crc-------------------------------------------------
9279 SUBROUTINE MATVEC2(A1,V1,V2)
9280 !DIR$ INLINEALWAYS MATVEC2
9282 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9284 implicit real*8 (a-h,o-z)
9285 include 'DIMENSIONS'
9286 DIMENSION A1(2,2),V1(2),V2(2)
9290 c 3 VI=VI+A1(I,K)*V1(K)
9294 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9295 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9300 C---------------------------------------
9301 SUBROUTINE MATMAT2(A1,A2,A3)
9303 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9305 implicit real*8 (a-h,o-z)
9306 include 'DIMENSIONS'
9307 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9308 c DIMENSION AI3(2,2)
9312 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9318 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9319 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9320 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9321 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9329 c-------------------------------------------------------------------------
9330 double precision function scalar2(u,v)
9331 !DIR$ INLINEALWAYS scalar2
9333 double precision u(2),v(2)
9336 scalar2=u(1)*v(1)+u(2)*v(2)
9340 C-----------------------------------------------------------------------------
9342 subroutine transpose2(a,at)
9343 !DIR$ INLINEALWAYS transpose2
9345 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9348 double precision a(2,2),at(2,2)
9355 c--------------------------------------------------------------------------
9356 subroutine transpose(n,a,at)
9359 double precision a(n,n),at(n,n)
9367 C---------------------------------------------------------------------------
9368 subroutine prodmat3(a1,a2,kk,transp,prod)
9369 !DIR$ INLINEALWAYS prodmat3
9371 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9375 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9377 crc double precision auxmat(2,2),prod_(2,2)
9380 crc call transpose2(kk(1,1),auxmat(1,1))
9381 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9382 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9384 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9385 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9386 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9387 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9388 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9389 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9390 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9391 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9394 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9395 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9397 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9398 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9399 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9400 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9401 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9402 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9403 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9404 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9407 c call transpose2(a2(1,1),a2t(1,1))
9410 crc print *,((prod_(i,j),i=1,2),j=1,2)
9411 crc print *,((prod(i,j),i=1,2),j=1,2)