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.
126 cmc Sep-06: egb takes care of dynamic ss bonds too
128 c if (dyn_ss) call dyn_set_nss
130 c print *,"Processor",myrank," computed USCSC"
136 time_vec=time_vec+MPI_Wtime()-time01
138 c print *,"Processor",myrank," left VEC_AND_DERIV"
141 if (welec.gt.0d0.or.wvdwpp.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 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
147 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
148 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
149 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
151 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
160 write (iout,*) "Soft-spheer ELEC potential"
161 c call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
164 c print *,"Processor",myrank," computed UELEC"
166 C Calculate excluded-volume interaction energy between peptide groups
171 call escp(evdw2,evdw2_14)
177 c write (iout,*) "Soft-sphere SCP potential"
178 call escp_soft_sphere(evdw2,evdw2_14)
181 c Calculate the bond-stretching energy
185 C Calculate the disulfide-bridge and other energy and the contributions
186 C from other distance constraints.
187 cd print *,'Calling EHPB'
189 cd print *,'EHPB exitted succesfully.'
191 C Calculate the virtual-bond-angle energy.
193 if (wang.gt.0d0) then
198 c print *,"Processor",myrank," computed UB"
200 C Calculate the SC local energy.
203 c print *,"Processor",myrank," computed USC"
205 C Calculate the virtual-bond torsional energy.
207 cd print *,'nterm=',nterm
209 call etor(etors,edihcnstr)
214 c print *,"Processor",myrank," computed Utor"
216 C 6/23/01 Calculate double-torsional energy
218 if (wtor_d.gt.0) then
223 c print *,"Processor",myrank," computed Utord"
225 C 21/5/07 Calculate local sicdechain correlation energy
227 if (wsccor.gt.0.0d0) then
228 call eback_sc_corr(esccor)
232 c print *,"Processor",myrank," computed Usccorr"
234 C 12/1/95 Multi-body terms
238 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
239 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
240 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
241 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
242 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
249 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
250 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
251 cd write (iout,*) "multibody_hb ecorr",ecorr
253 c print *,"Processor",myrank," computed Ucorr"
255 C If performing constraint dynamics, call the constraint energy
256 C after the equilibration time
257 if(usampl.and.totT.gt.eq_time) then
265 time_enecalc=time_enecalc+MPI_Wtime()-time00
267 c print *,"Processor",myrank," computed Uconstr"
276 energia(2)=evdw2-evdw2_14
293 energia(8)=eello_turn3
294 energia(9)=eello_turn4
301 energia(19)=edihcnstr
303 energia(20)=Uconst+Uconst_back
305 c Here are the energies showed per procesor if the are more processors
306 c per molecule then we sum it up in sum_energy subroutine
307 c print *," Processor",myrank," calls SUM_ENERGY"
308 call sum_energy(energia,.true.)
309 if (dyn_ss) call dyn_set_nss
310 c print *," Processor",myrank," left SUM_ENERGY"
312 time_sumene=time_sumene+MPI_Wtime()-time00
316 c-------------------------------------------------------------------------------
317 subroutine sum_energy(energia,reduce)
318 implicit real*8 (a-h,o-z)
323 cMS$ATTRIBUTES C :: proc_proc
329 include 'COMMON.SETUP'
330 include 'COMMON.IOUNITS'
331 double precision energia(0:n_ene),enebuff(0:n_ene+1)
332 include 'COMMON.FFIELD'
333 include 'COMMON.DERIV'
334 include 'COMMON.INTERACT'
335 include 'COMMON.SBRIDGE'
336 include 'COMMON.CHAIN'
338 include 'COMMON.CONTROL'
339 include 'COMMON.TIME1'
342 if (nfgtasks.gt.1 .and. reduce) then
344 write (iout,*) "energies before REDUCE"
345 call enerprint(energia)
349 enebuff(i)=energia(i)
352 call MPI_Barrier(FG_COMM,IERR)
353 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
355 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
356 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
358 write (iout,*) "energies after REDUCE"
359 call enerprint(energia)
362 time_Reduce=time_Reduce+MPI_Wtime()-time00
364 if (fg_rank.eq.0) then
368 evdw2=energia(2)+energia(18)
384 eello_turn3=energia(8)
385 eello_turn4=energia(9)
392 edihcnstr=energia(19)
397 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
398 & +wang*ebe+wtor*etors+wscloc*escloc
399 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
400 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
401 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
402 & +wbond*estr+Uconst+wsccor*esccor
404 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
405 & +wang*ebe+wtor*etors+wscloc*escloc
406 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
407 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
408 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
409 & +wbond*estr+Uconst+wsccor*esccor
415 if (isnan(etot).ne.0) energia(0)=1.0d+99
417 if (isnan(etot)) energia(0)=1.0d+99
422 idumm=proc_proc(etot,i)
424 call proc_proc(etot,i)
426 if(i.eq.1)energia(0)=1.0d+99
433 c-------------------------------------------------------------------------------
434 subroutine sum_gradient
435 implicit real*8 (a-h,o-z)
440 cMS$ATTRIBUTES C :: proc_proc
446 double precision gradbufc(3,maxres),gradbufx(3,maxres),
447 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
448 include 'COMMON.SETUP'
449 include 'COMMON.IOUNITS'
450 include 'COMMON.FFIELD'
451 include 'COMMON.DERIV'
452 include 'COMMON.INTERACT'
453 include 'COMMON.SBRIDGE'
454 include 'COMMON.CHAIN'
456 include 'COMMON.CONTROL'
457 include 'COMMON.TIME1'
458 include 'COMMON.MAXGRAD'
459 include 'COMMON.SCCOR'
464 write (iout,*) "sum_gradient gvdwc, gvdwx"
466 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
467 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
472 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
473 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
474 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
477 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
478 C in virtual-bond-vector coordinates
481 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
483 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
484 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
486 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
488 c write (iout,'(i5,3f10.5,2x,f10.5)')
489 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
491 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
493 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
494 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
502 gradbufc(j,i)=wsc*gvdwc(j,i)+
503 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
504 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
505 & wel_loc*gel_loc_long(j,i)+
506 & wcorr*gradcorr_long(j,i)+
507 & wcorr5*gradcorr5_long(j,i)+
508 & wcorr6*gradcorr6_long(j,i)+
509 & wturn6*gcorr6_turn_long(j,i)+
516 gradbufc(j,i)=wsc*gvdwc(j,i)+
517 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
518 & welec*gelc_long(j,i)+
520 & wel_loc*gel_loc_long(j,i)+
521 & wcorr*gradcorr_long(j,i)+
522 & wcorr5*gradcorr5_long(j,i)+
523 & wcorr6*gradcorr6_long(j,i)+
524 & wturn6*gcorr6_turn_long(j,i)+
530 if (nfgtasks.gt.1) then
533 write (iout,*) "gradbufc before allreduce"
535 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
541 gradbufc_sum(j,i)=gradbufc(j,i)
544 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
545 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
546 c time_reduce=time_reduce+MPI_Wtime()-time00
548 c write (iout,*) "gradbufc_sum after allreduce"
550 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
555 c time_allreduce=time_allreduce+MPI_Wtime()-time00
563 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
564 write (iout,*) (i," jgrad_start",jgrad_start(i),
565 & " jgrad_end ",jgrad_end(i),
566 & i=igrad_start,igrad_end)
569 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
570 c do not parallelize this part.
572 c do i=igrad_start,igrad_end
573 c do j=jgrad_start(i),jgrad_end(i)
575 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
580 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
584 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
588 write (iout,*) "gradbufc after summing"
590 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
597 write (iout,*) "gradbufc"
599 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
605 gradbufc_sum(j,i)=gradbufc(j,i)
610 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
614 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
619 c gradbufc(k,i)=0.0d0
623 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
628 write (iout,*) "gradbufc after summing"
630 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
638 gradbufc(k,nres)=0.0d0
643 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
644 & wel_loc*gel_loc(j,i)+
645 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
646 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
647 & wel_loc*gel_loc_long(j,i)+
648 & wcorr*gradcorr_long(j,i)+
649 & wcorr5*gradcorr5_long(j,i)+
650 & wcorr6*gradcorr6_long(j,i)+
651 & wturn6*gcorr6_turn_long(j,i))+
653 & wcorr*gradcorr(j,i)+
654 & wturn3*gcorr3_turn(j,i)+
655 & wturn4*gcorr4_turn(j,i)+
656 & wcorr5*gradcorr5(j,i)+
657 & wcorr6*gradcorr6(j,i)+
658 & wturn6*gcorr6_turn(j,i)+
659 & wsccor*gsccorc(j,i)
660 & +wscloc*gscloc(j,i)
662 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
663 & wel_loc*gel_loc(j,i)+
664 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
665 & welec*gelc_long(j,i)
666 & wel_loc*gel_loc_long(j,i)+
667 & wcorr*gcorr_long(j,i)+
668 & wcorr5*gradcorr5_long(j,i)+
669 & wcorr6*gradcorr6_long(j,i)+
670 & wturn6*gcorr6_turn_long(j,i))+
672 & wcorr*gradcorr(j,i)+
673 & wturn3*gcorr3_turn(j,i)+
674 & wturn4*gcorr4_turn(j,i)+
675 & wcorr5*gradcorr5(j,i)+
676 & wcorr6*gradcorr6(j,i)+
677 & wturn6*gcorr6_turn(j,i)+
678 & wsccor*gsccorc(j,i)
679 & +wscloc*gscloc(j,i)
681 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
683 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
684 & wsccor*gsccorx(j,i)
685 & +wscloc*gsclocx(j,i)
689 write (iout,*) "gloc before adding corr"
691 write (iout,*) i,gloc(i,icg)
695 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
696 & +wcorr5*g_corr5_loc(i)
697 & +wcorr6*g_corr6_loc(i)
698 & +wturn4*gel_loc_turn4(i)
699 & +wturn3*gel_loc_turn3(i)
700 & +wturn6*gel_loc_turn6(i)
701 & +wel_loc*gel_loc_loc(i)
704 write (iout,*) "gloc after adding corr"
706 write (iout,*) i,gloc(i,icg)
710 if (nfgtasks.gt.1) then
713 gradbufc(j,i)=gradc(j,i,icg)
714 gradbufx(j,i)=gradx(j,i,icg)
718 glocbuf(i)=gloc(i,icg)
722 write (iout,*) "gloc_sc before reduce"
725 write (iout,*) i,j,gloc_sc(j,i,icg)
732 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
736 call MPI_Barrier(FG_COMM,IERR)
737 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
739 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
740 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
741 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
742 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
743 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
744 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
745 time_reduce=time_reduce+MPI_Wtime()-time00
746 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
747 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
748 time_reduce=time_reduce+MPI_Wtime()-time00
751 write (iout,*) "gloc_sc after reduce"
754 write (iout,*) i,j,gloc_sc(j,i,icg)
760 write (iout,*) "gloc after reduce"
762 write (iout,*) i,gloc(i,icg)
767 if (gnorm_check) then
769 c Compute the maximum elements of the gradient
779 gcorr3_turn_max=0.0d0
780 gcorr4_turn_max=0.0d0
783 gcorr6_turn_max=0.0d0
793 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
794 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
795 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
796 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
797 & gvdwc_scp_max=gvdwc_scp_norm
798 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
799 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
800 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
801 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
802 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
803 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
804 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
805 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
806 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
807 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
808 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
809 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
810 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
812 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
813 & gcorr3_turn_max=gcorr3_turn_norm
814 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
816 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
817 & gcorr4_turn_max=gcorr4_turn_norm
818 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
819 if (gradcorr5_norm.gt.gradcorr5_max)
820 & gradcorr5_max=gradcorr5_norm
821 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
822 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
823 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
825 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
826 & gcorr6_turn_max=gcorr6_turn_norm
827 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
828 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
829 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
830 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
831 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
832 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
833 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
834 if (gradx_scp_norm.gt.gradx_scp_max)
835 & gradx_scp_max=gradx_scp_norm
836 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
837 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
838 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
839 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
840 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
841 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
842 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
843 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
847 open(istat,file=statname,position="append")
849 open(istat,file=statname,access="append")
851 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
852 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
853 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
854 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
855 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
856 & gsccorx_max,gsclocx_max
858 if (gvdwc_max.gt.1.0d4) then
859 write (iout,*) "gvdwc gvdwx gradb gradbx"
861 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
862 & gradb(j,i),gradbx(j,i),j=1,3)
864 call pdbout(0.0d0,'cipiszcze',iout)
870 write (iout,*) "gradc gradx gloc"
872 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
873 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
877 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
881 c-------------------------------------------------------------------------------
882 subroutine rescale_weights(t_bath)
883 implicit real*8 (a-h,o-z)
885 include 'COMMON.IOUNITS'
886 include 'COMMON.FFIELD'
887 include 'COMMON.SBRIDGE'
888 double precision kfac /2.4d0/
889 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
891 c facT=2*temp0/(t_bath+temp0)
892 if (rescale_mode.eq.0) then
898 else if (rescale_mode.eq.1) then
899 facT=kfac/(kfac-1.0d0+t_bath/temp0)
900 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
901 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
902 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
903 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
904 else if (rescale_mode.eq.2) then
910 facT=licznik/dlog(dexp(x)+dexp(-x))
911 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
912 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
913 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
914 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
916 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
917 write (*,*) "Wrong RESCALE_MODE",rescale_mode
919 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
923 welec=weights(3)*fact
924 wcorr=weights(4)*fact3
925 wcorr5=weights(5)*fact4
926 wcorr6=weights(6)*fact5
927 wel_loc=weights(7)*fact2
928 wturn3=weights(8)*fact2
929 wturn4=weights(9)*fact3
930 wturn6=weights(10)*fact5
931 wtor=weights(13)*fact
932 wtor_d=weights(14)*fact2
933 wsccor=weights(21)*fact
937 C------------------------------------------------------------------------
938 subroutine enerprint(energia)
939 implicit real*8 (a-h,o-z)
941 include 'COMMON.IOUNITS'
942 include 'COMMON.FFIELD'
943 include 'COMMON.SBRIDGE'
945 double precision energia(0:n_ene)
950 evdw2=energia(2)+energia(18)
962 eello_turn3=energia(8)
963 eello_turn4=energia(9)
964 eello_turn6=energia(10)
970 edihcnstr=energia(19)
975 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
976 & estr,wbond,ebe,wang,
977 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
979 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
980 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
983 10 format (/'Virtual-chain energies:'//
984 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
985 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
986 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
987 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
988 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
989 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
990 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
991 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
992 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
993 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
994 & ' (SS bridges & dist. cnstr.)'/
995 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
996 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
997 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
998 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
999 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1000 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1001 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1002 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1003 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1004 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1005 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1006 & 'ETOT= ',1pE16.6,' (total)')
1008 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1009 & estr,wbond,ebe,wang,
1010 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1012 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1013 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1014 & ebr*nss,Uconst,etot
1015 10 format (/'Virtual-chain energies:'//
1016 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1017 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1018 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1019 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1020 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1021 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1022 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1023 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1024 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1025 & ' (SS bridges & dist. cnstr.)'/
1026 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1027 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1028 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1029 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1030 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1031 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1032 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1033 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1034 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1035 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1036 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1037 & 'ETOT= ',1pE16.6,' (total)')
1041 C-----------------------------------------------------------------------
1042 subroutine elj(evdw)
1044 C This subroutine calculates the interaction energy of nonbonded side chains
1045 C assuming the LJ potential of interaction.
1047 implicit real*8 (a-h,o-z)
1048 include 'DIMENSIONS'
1049 parameter (accur=1.0d-10)
1050 include 'COMMON.GEO'
1051 include 'COMMON.VAR'
1052 include 'COMMON.LOCAL'
1053 include 'COMMON.CHAIN'
1054 include 'COMMON.DERIV'
1055 include 'COMMON.INTERACT'
1056 include 'COMMON.TORSION'
1057 include 'COMMON.SBRIDGE'
1058 include 'COMMON.NAMES'
1059 include 'COMMON.IOUNITS'
1060 include 'COMMON.CONTACTS'
1062 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1064 do i=iatsc_s,iatsc_e
1065 itypi=iabs(itype(i))
1066 if (itypi.eq.ntyp1) cycle
1067 itypi1=iabs(itype(i+1))
1074 C Calculate SC interaction energy.
1076 do iint=1,nint_gr(i)
1077 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1078 cd & 'iend=',iend(i,iint)
1079 do j=istart(i,iint),iend(i,iint)
1080 itypj=iabs(itype(j))
1081 if (itypj.eq.ntyp1) cycle
1085 C Change 12/1/95 to calculate four-body interactions
1086 rij=xj*xj+yj*yj+zj*zj
1088 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1089 eps0ij=eps(itypi,itypj)
1091 e1=fac*fac*aa(itypi,itypj)
1092 e2=fac*bb(itypi,itypj)
1094 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1095 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1096 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1097 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1098 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1099 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1102 C Calculate the components of the gradient in DC and X
1104 fac=-rrij*(e1+evdwij)
1109 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1110 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1111 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1112 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1116 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1120 C 12/1/95, revised on 5/20/97
1122 C Calculate the contact function. The ith column of the array JCONT will
1123 C contain the numbers of atoms that make contacts with the atom I (of numbers
1124 C greater than I). The arrays FACONT and GACONT will contain the values of
1125 C the contact function and its derivative.
1127 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1128 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1129 C Uncomment next line, if the correlation interactions are contact function only
1130 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1132 sigij=sigma(itypi,itypj)
1133 r0ij=rs0(itypi,itypj)
1135 C Check whether the SC's are not too far to make a contact.
1138 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1139 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1141 if (fcont.gt.0.0D0) then
1142 C If the SC-SC distance if close to sigma, apply spline.
1143 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1144 cAdam & fcont1,fprimcont1)
1145 cAdam fcont1=1.0d0-fcont1
1146 cAdam if (fcont1.gt.0.0d0) then
1147 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1148 cAdam fcont=fcont*fcont1
1150 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1151 cga eps0ij=1.0d0/dsqrt(eps0ij)
1153 cga gg(k)=gg(k)*eps0ij
1155 cga eps0ij=-evdwij*eps0ij
1156 C Uncomment for AL's type of SC correlation interactions.
1157 cadam eps0ij=-evdwij
1158 num_conti=num_conti+1
1159 jcont(num_conti,i)=j
1160 facont(num_conti,i)=fcont*eps0ij
1161 fprimcont=eps0ij*fprimcont/rij
1163 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1164 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1165 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1166 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1167 gacont(1,num_conti,i)=-fprimcont*xj
1168 gacont(2,num_conti,i)=-fprimcont*yj
1169 gacont(3,num_conti,i)=-fprimcont*zj
1170 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1171 cd write (iout,'(2i3,3f10.5)')
1172 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1178 num_cont(i)=num_conti
1182 gvdwc(j,i)=expon*gvdwc(j,i)
1183 gvdwx(j,i)=expon*gvdwx(j,i)
1186 C******************************************************************************
1190 C To save time, the factor of EXPON has been extracted from ALL components
1191 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1194 C******************************************************************************
1197 C-----------------------------------------------------------------------------
1198 subroutine eljk(evdw)
1200 C This subroutine calculates the interaction energy of nonbonded side chains
1201 C assuming the LJK potential of interaction.
1203 implicit real*8 (a-h,o-z)
1204 include 'DIMENSIONS'
1205 include 'COMMON.GEO'
1206 include 'COMMON.VAR'
1207 include 'COMMON.LOCAL'
1208 include 'COMMON.CHAIN'
1209 include 'COMMON.DERIV'
1210 include 'COMMON.INTERACT'
1211 include 'COMMON.IOUNITS'
1212 include 'COMMON.NAMES'
1215 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1217 do i=iatsc_s,iatsc_e
1218 itypi=iabs(itype(i))
1219 if (itypi.eq.ntyp1) cycle
1220 itypi1=iabs(itype(i+1))
1225 C Calculate SC interaction energy.
1227 do iint=1,nint_gr(i)
1228 do j=istart(i,iint),iend(i,iint)
1229 itypj=iabs(itype(j))
1230 if (itypj.eq.ntyp1) cycle
1234 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1235 fac_augm=rrij**expon
1236 e_augm=augm(itypi,itypj)*fac_augm
1237 r_inv_ij=dsqrt(rrij)
1239 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1240 fac=r_shift_inv**expon
1241 e1=fac*fac*aa(itypi,itypj)
1242 e2=fac*bb(itypi,itypj)
1244 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1245 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1246 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1247 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1248 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1249 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1250 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1253 C Calculate the components of the gradient in DC and X
1255 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1260 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1261 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1262 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1263 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1267 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1275 gvdwc(j,i)=expon*gvdwc(j,i)
1276 gvdwx(j,i)=expon*gvdwx(j,i)
1281 C-----------------------------------------------------------------------------
1282 subroutine ebp(evdw)
1284 C This subroutine calculates the interaction energy of nonbonded side chains
1285 C assuming the Berne-Pechukas potential of interaction.
1287 implicit real*8 (a-h,o-z)
1288 include 'DIMENSIONS'
1289 include 'COMMON.GEO'
1290 include 'COMMON.VAR'
1291 include 'COMMON.LOCAL'
1292 include 'COMMON.CHAIN'
1293 include 'COMMON.DERIV'
1294 include 'COMMON.NAMES'
1295 include 'COMMON.INTERACT'
1296 include 'COMMON.IOUNITS'
1297 include 'COMMON.CALC'
1298 common /srutu/ icall
1299 c double precision rrsave(maxdim)
1302 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1304 c if (icall.eq.0) then
1310 do i=iatsc_s,iatsc_e
1311 itypi=iabs(itype(i))
1312 if (itypi.eq.ntyp1) cycle
1313 itypi1=iabs(itype(i+1))
1317 dxi=dc_norm(1,nres+i)
1318 dyi=dc_norm(2,nres+i)
1319 dzi=dc_norm(3,nres+i)
1320 c dsci_inv=dsc_inv(itypi)
1321 dsci_inv=vbld_inv(i+nres)
1323 C Calculate SC interaction energy.
1325 do iint=1,nint_gr(i)
1326 do j=istart(i,iint),iend(i,iint)
1328 itypj=iabs(itype(j))
1329 if (itypj.eq.ntyp1) cycle
1330 c dscj_inv=dsc_inv(itypj)
1331 dscj_inv=vbld_inv(j+nres)
1332 chi1=chi(itypi,itypj)
1333 chi2=chi(itypj,itypi)
1340 alf12=0.5D0*(alf1+alf2)
1341 C For diagnostics only!!!
1354 dxj=dc_norm(1,nres+j)
1355 dyj=dc_norm(2,nres+j)
1356 dzj=dc_norm(3,nres+j)
1357 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1358 cd if (icall.eq.0) then
1364 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1366 C Calculate whole angle-dependent part of epsilon and contributions
1367 C to its derivatives
1368 fac=(rrij*sigsq)**expon2
1369 e1=fac*fac*aa(itypi,itypj)
1370 e2=fac*bb(itypi,itypj)
1371 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1372 eps2der=evdwij*eps3rt
1373 eps3der=evdwij*eps2rt
1374 evdwij=evdwij*eps2rt*eps3rt
1377 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1378 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1379 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1380 cd & restyp(itypi),i,restyp(itypj),j,
1381 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1382 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1383 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1386 C Calculate gradient components.
1387 e1=e1*eps1*eps2rt**2*eps3rt**2
1388 fac=-expon*(e1+evdwij)
1391 C Calculate radial part of the gradient
1395 C Calculate the angular part of the gradient and sum add the contributions
1396 C to the appropriate components of the Cartesian gradient.
1404 C-----------------------------------------------------------------------------
1405 subroutine egb(evdw)
1407 C This subroutine calculates the interaction energy of nonbonded side chains
1408 C assuming the Gay-Berne potential of interaction.
1410 implicit real*8 (a-h,o-z)
1411 include 'DIMENSIONS'
1412 include 'COMMON.GEO'
1413 include 'COMMON.VAR'
1414 include 'COMMON.LOCAL'
1415 include 'COMMON.CHAIN'
1416 include 'COMMON.DERIV'
1417 include 'COMMON.NAMES'
1418 include 'COMMON.INTERACT'
1419 include 'COMMON.IOUNITS'
1420 include 'COMMON.CALC'
1421 include 'COMMON.CONTROL'
1422 include 'COMMON.SPLITELE'
1423 include 'COMMON.SBRIDGE'
1425 integer xshift,yshift,zshift
1427 ccccc energy_dec=.false.
1428 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1431 c if (icall.eq.0) lprn=.false.
1433 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1434 C we have the original box)
1438 do i=iatsc_s,iatsc_e
1439 itypi=iabs(itype(i))
1440 if (itypi.eq.ntyp1) cycle
1441 itypi1=iabs(itype(i+1))
1445 C Return atom into box, boxxsize is size of box in x dimension
1447 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1448 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1449 C Condition for being inside the proper box
1450 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1451 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1455 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1456 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1457 C Condition for being inside the proper box
1458 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1459 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1463 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1464 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1465 C Condition for being inside the proper box
1466 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1467 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1471 if (xi.lt.0) xi=xi+boxxsize
1473 if (yi.lt.0) yi=yi+boxysize
1475 if (zi.lt.0) zi=zi+boxzsize
1476 C xi=xi+xshift*boxxsize
1477 C yi=yi+yshift*boxysize
1478 C zi=zi+zshift*boxzsize
1480 dxi=dc_norm(1,nres+i)
1481 dyi=dc_norm(2,nres+i)
1482 dzi=dc_norm(3,nres+i)
1483 c dsci_inv=dsc_inv(itypi)
1484 dsci_inv=vbld_inv(i+nres)
1485 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1486 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1488 C Calculate SC interaction energy.
1490 do iint=1,nint_gr(i)
1491 do j=istart(i,iint),iend(i,iint)
1492 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1493 call dyn_ssbond_ene(i,j,evdwij)
1495 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1496 & 'evdw',i,j,evdwij,' ss'
1499 itypj=iabs(itype(j))
1500 if (itypj.eq.ntyp1) cycle
1501 c dscj_inv=dsc_inv(itypj)
1502 dscj_inv=vbld_inv(j+nres)
1503 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1504 c & 1.0d0/vbld(j+nres)
1505 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1506 sig0ij=sigma(itypi,itypj)
1507 chi1=chi(itypi,itypj)
1508 chi2=chi(itypj,itypi)
1515 alf12=0.5D0*(alf1+alf2)
1516 C For diagnostics only!!!
1529 C Return atom J into box the original box
1531 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1532 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1533 C Condition for being inside the proper box
1534 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1535 c & (xj.lt.((-0.5d0)*boxxsize))) then
1539 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1540 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1541 C Condition for being inside the proper box
1542 c if ((yj.gt.((0.5d0)*boxysize)).or.
1543 c & (yj.lt.((-0.5d0)*boxysize))) then
1547 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1548 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1549 C Condition for being inside the proper box
1550 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1551 c & (zj.lt.((-0.5d0)*boxzsize))) then
1555 if (xj.lt.0) xj=xj+boxxsize
1557 if (yj.lt.0) yj=yj+boxysize
1559 if (zj.lt.0) zj=zj+boxzsize
1560 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1568 xj=xj_safe+xshift*boxxsize
1569 yj=yj_safe+yshift*boxysize
1570 zj=zj_safe+zshift*boxzsize
1571 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1572 if(dist_temp.lt.dist_init) then
1582 if (subchap.eq.1) then
1591 dxj=dc_norm(1,nres+j)
1592 dyj=dc_norm(2,nres+j)
1593 dzj=dc_norm(3,nres+j)
1597 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1598 c write (iout,*) "j",j," dc_norm",
1599 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1600 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1602 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1603 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1605 c write (iout,'(a7,4f8.3)')
1606 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1607 if (sss.gt.0.0d0) then
1608 C Calculate angle-dependent terms of energy and contributions to their
1612 sig=sig0ij*dsqrt(sigsq)
1613 rij_shift=1.0D0/rij-sig+sig0ij
1614 c for diagnostics; uncomment
1615 c rij_shift=1.2*sig0ij
1616 C I hate to put IF's in the loops, but here don't have another choice!!!!
1617 if (rij_shift.le.0.0D0) then
1619 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1620 cd & restyp(itypi),i,restyp(itypj),j,
1621 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1625 c---------------------------------------------------------------
1626 rij_shift=1.0D0/rij_shift
1627 fac=rij_shift**expon
1628 e1=fac*fac*aa(itypi,itypj)
1629 e2=fac*bb(itypi,itypj)
1630 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1631 eps2der=evdwij*eps3rt
1632 eps3der=evdwij*eps2rt
1633 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1634 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1635 evdwij=evdwij*eps2rt*eps3rt
1636 evdw=evdw+evdwij*sss
1638 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1639 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1640 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1641 & restyp(itypi),i,restyp(itypj),j,
1642 & epsi,sigm,chi1,chi2,chip1,chip2,
1643 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1644 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1648 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1651 C Calculate gradient components.
1652 e1=e1*eps1*eps2rt**2*eps3rt**2
1653 fac=-expon*(e1+evdwij)*rij_shift
1656 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1657 c & evdwij,fac,sigma(itypi,itypj),expon
1658 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1660 C Calculate the radial part of the gradient
1664 C Calculate angular part of the gradient.
1673 c write (iout,*) "Number of loop steps in EGB:",ind
1674 cccc energy_dec=.false.
1677 C-----------------------------------------------------------------------------
1678 subroutine egbv(evdw)
1680 C This subroutine calculates the interaction energy of nonbonded side chains
1681 C assuming the Gay-Berne-Vorobjev potential of interaction.
1683 implicit real*8 (a-h,o-z)
1684 include 'DIMENSIONS'
1685 include 'COMMON.GEO'
1686 include 'COMMON.VAR'
1687 include 'COMMON.LOCAL'
1688 include 'COMMON.CHAIN'
1689 include 'COMMON.DERIV'
1690 include 'COMMON.NAMES'
1691 include 'COMMON.INTERACT'
1692 include 'COMMON.IOUNITS'
1693 include 'COMMON.CALC'
1694 common /srutu/ icall
1697 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1700 c if (icall.eq.0) lprn=.true.
1702 do i=iatsc_s,iatsc_e
1703 itypi=iabs(itype(i))
1704 if (itypi.eq.ntyp1) cycle
1705 itypi1=iabs(itype(i+1))
1709 dxi=dc_norm(1,nres+i)
1710 dyi=dc_norm(2,nres+i)
1711 dzi=dc_norm(3,nres+i)
1712 c dsci_inv=dsc_inv(itypi)
1713 dsci_inv=vbld_inv(i+nres)
1715 C Calculate SC interaction energy.
1717 do iint=1,nint_gr(i)
1718 do j=istart(i,iint),iend(i,iint)
1720 itypj=iabs(itype(j))
1721 if (itypj.eq.ntyp1) cycle
1722 c dscj_inv=dsc_inv(itypj)
1723 dscj_inv=vbld_inv(j+nres)
1724 sig0ij=sigma(itypi,itypj)
1725 r0ij=r0(itypi,itypj)
1726 chi1=chi(itypi,itypj)
1727 chi2=chi(itypj,itypi)
1734 alf12=0.5D0*(alf1+alf2)
1735 C For diagnostics only!!!
1748 dxj=dc_norm(1,nres+j)
1749 dyj=dc_norm(2,nres+j)
1750 dzj=dc_norm(3,nres+j)
1751 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1753 C Calculate angle-dependent terms of energy and contributions to their
1757 sig=sig0ij*dsqrt(sigsq)
1758 rij_shift=1.0D0/rij-sig+r0ij
1759 C I hate to put IF's in the loops, but here don't have another choice!!!!
1760 if (rij_shift.le.0.0D0) then
1765 c---------------------------------------------------------------
1766 rij_shift=1.0D0/rij_shift
1767 fac=rij_shift**expon
1768 e1=fac*fac*aa(itypi,itypj)
1769 e2=fac*bb(itypi,itypj)
1770 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1771 eps2der=evdwij*eps3rt
1772 eps3der=evdwij*eps2rt
1773 fac_augm=rrij**expon
1774 e_augm=augm(itypi,itypj)*fac_augm
1775 evdwij=evdwij*eps2rt*eps3rt
1776 evdw=evdw+evdwij+e_augm
1778 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1779 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1780 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1781 & restyp(itypi),i,restyp(itypj),j,
1782 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1783 & chi1,chi2,chip1,chip2,
1784 & eps1,eps2rt**2,eps3rt**2,
1785 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1788 C Calculate gradient components.
1789 e1=e1*eps1*eps2rt**2*eps3rt**2
1790 fac=-expon*(e1+evdwij)*rij_shift
1792 fac=rij*fac-2*expon*rrij*e_augm
1793 C Calculate the radial part of the gradient
1797 C Calculate angular part of the gradient.
1803 C-----------------------------------------------------------------------------
1804 subroutine sc_angular
1805 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1806 C om12. Called by ebp, egb, and egbv.
1808 include 'COMMON.CALC'
1809 include 'COMMON.IOUNITS'
1813 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1814 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1815 om12=dxi*dxj+dyi*dyj+dzi*dzj
1817 C Calculate eps1(om12) and its derivative in om12
1818 faceps1=1.0D0-om12*chiom12
1819 faceps1_inv=1.0D0/faceps1
1820 eps1=dsqrt(faceps1_inv)
1821 C Following variable is eps1*deps1/dom12
1822 eps1_om12=faceps1_inv*chiom12
1827 c write (iout,*) "om12",om12," eps1",eps1
1828 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1833 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1834 sigsq=1.0D0-facsig*faceps1_inv
1835 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1836 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1837 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1843 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1844 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1846 C Calculate eps2 and its derivatives in om1, om2, and om12.
1849 chipom12=chip12*om12
1850 facp=1.0D0-om12*chipom12
1852 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1853 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1854 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1855 C Following variable is the square root of eps2
1856 eps2rt=1.0D0-facp1*facp_inv
1857 C Following three variables are the derivatives of the square root of eps
1858 C in om1, om2, and om12.
1859 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1860 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1861 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1862 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1863 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1864 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1865 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1866 c & " eps2rt_om12",eps2rt_om12
1867 C Calculate whole angle-dependent part of epsilon and contributions
1868 C to its derivatives
1871 C----------------------------------------------------------------------------
1873 implicit real*8 (a-h,o-z)
1874 include 'DIMENSIONS'
1875 include 'COMMON.CHAIN'
1876 include 'COMMON.DERIV'
1877 include 'COMMON.CALC'
1878 include 'COMMON.IOUNITS'
1879 double precision dcosom1(3),dcosom2(3)
1880 cc print *,'sss=',sss
1881 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1882 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1883 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1884 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1888 c eom12=evdwij*eps1_om12
1890 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1891 c & " sigder",sigder
1892 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1893 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1895 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1896 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1899 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
1901 c write (iout,*) "gg",(gg(k),k=1,3)
1903 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1904 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1905 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
1906 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1907 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1908 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
1909 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1910 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1911 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1912 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1915 C Calculate the components of the gradient in DC and X
1919 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1923 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1924 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1928 C-----------------------------------------------------------------------
1929 subroutine e_softsphere(evdw)
1931 C This subroutine calculates the interaction energy of nonbonded side chains
1932 C assuming the LJ potential of interaction.
1934 implicit real*8 (a-h,o-z)
1935 include 'DIMENSIONS'
1936 parameter (accur=1.0d-10)
1937 include 'COMMON.GEO'
1938 include 'COMMON.VAR'
1939 include 'COMMON.LOCAL'
1940 include 'COMMON.CHAIN'
1941 include 'COMMON.DERIV'
1942 include 'COMMON.INTERACT'
1943 include 'COMMON.TORSION'
1944 include 'COMMON.SBRIDGE'
1945 include 'COMMON.NAMES'
1946 include 'COMMON.IOUNITS'
1947 include 'COMMON.CONTACTS'
1949 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1951 do i=iatsc_s,iatsc_e
1952 itypi=iabs(itype(i))
1953 if (itypi.eq.ntyp1) cycle
1954 itypi1=iabs(itype(i+1))
1959 C Calculate SC interaction energy.
1961 do iint=1,nint_gr(i)
1962 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1963 cd & 'iend=',iend(i,iint)
1964 do j=istart(i,iint),iend(i,iint)
1965 itypj=iabs(itype(j))
1966 if (itypj.eq.ntyp1) cycle
1970 rij=xj*xj+yj*yj+zj*zj
1971 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1972 r0ij=r0(itypi,itypj)
1974 c print *,i,j,r0ij,dsqrt(rij)
1975 if (rij.lt.r0ijsq) then
1976 evdwij=0.25d0*(rij-r0ijsq)**2
1984 C Calculate the components of the gradient in DC and X
1990 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1991 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1992 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1993 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1997 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2005 C--------------------------------------------------------------------------
2006 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2009 C Soft-sphere potential of p-p interaction
2011 implicit real*8 (a-h,o-z)
2012 include 'DIMENSIONS'
2013 include 'COMMON.CONTROL'
2014 include 'COMMON.IOUNITS'
2015 include 'COMMON.GEO'
2016 include 'COMMON.VAR'
2017 include 'COMMON.LOCAL'
2018 include 'COMMON.CHAIN'
2019 include 'COMMON.DERIV'
2020 include 'COMMON.INTERACT'
2021 include 'COMMON.CONTACTS'
2022 include 'COMMON.TORSION'
2023 include 'COMMON.VECTORS'
2024 include 'COMMON.FFIELD'
2026 C write(iout,*) 'In EELEC_soft_sphere'
2033 do i=iatel_s,iatel_e
2034 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2038 xmedi=c(1,i)+0.5d0*dxi
2039 ymedi=c(2,i)+0.5d0*dyi
2040 zmedi=c(3,i)+0.5d0*dzi
2041 xmedi=mod(xmedi,boxxsize)
2042 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2043 ymedi=mod(ymedi,boxysize)
2044 if (ymedi.lt.0) ymedi=ymedi+boxysize
2045 zmedi=mod(zmedi,boxzsize)
2046 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2048 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2049 do j=ielstart(i),ielend(i)
2050 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2054 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2055 r0ij=rpp(iteli,itelj)
2064 if (xj.lt.0) xj=xj+boxxsize
2066 if (yj.lt.0) yj=yj+boxysize
2068 if (zj.lt.0) zj=zj+boxzsize
2069 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2077 xj=xj_safe+xshift*boxxsize
2078 yj=yj_safe+yshift*boxysize
2079 zj=zj_safe+zshift*boxzsize
2080 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2081 if(dist_temp.lt.dist_init) then
2091 if (isubchap.eq.1) then
2100 rij=xj*xj+yj*yj+zj*zj
2101 sss=sscale(sqrt(rij))
2102 sssgrad=sscagrad(sqrt(rij))
2103 if (rij.lt.r0ijsq) then
2104 evdw1ij=0.25d0*(rij-r0ijsq)**2
2110 evdw1=evdw1+evdw1ij*sss
2112 C Calculate contributions to the Cartesian gradient.
2114 ggg(1)=fac*xj*sssgrad
2115 ggg(2)=fac*yj*sssgrad
2116 ggg(3)=fac*zj*sssgrad
2118 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2119 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2122 * Loop over residues i+1 thru j-1.
2126 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2131 cgrad do i=nnt,nct-1
2133 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2135 cgrad do j=i+1,nct-1
2137 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2143 c------------------------------------------------------------------------------
2144 subroutine vec_and_deriv
2145 implicit real*8 (a-h,o-z)
2146 include 'DIMENSIONS'
2150 include 'COMMON.IOUNITS'
2151 include 'COMMON.GEO'
2152 include 'COMMON.VAR'
2153 include 'COMMON.LOCAL'
2154 include 'COMMON.CHAIN'
2155 include 'COMMON.VECTORS'
2156 include 'COMMON.SETUP'
2157 include 'COMMON.TIME1'
2158 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2159 C Compute the local reference systems. For reference system (i), the
2160 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2161 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2163 do i=ivec_start,ivec_end
2167 if (i.eq.nres-1) then
2168 C Case of the last full residue
2169 C Compute the Z-axis
2170 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2171 costh=dcos(pi-theta(nres))
2172 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2176 C Compute the derivatives of uz
2178 uzder(2,1,1)=-dc_norm(3,i-1)
2179 uzder(3,1,1)= dc_norm(2,i-1)
2180 uzder(1,2,1)= dc_norm(3,i-1)
2182 uzder(3,2,1)=-dc_norm(1,i-1)
2183 uzder(1,3,1)=-dc_norm(2,i-1)
2184 uzder(2,3,1)= dc_norm(1,i-1)
2187 uzder(2,1,2)= dc_norm(3,i)
2188 uzder(3,1,2)=-dc_norm(2,i)
2189 uzder(1,2,2)=-dc_norm(3,i)
2191 uzder(3,2,2)= dc_norm(1,i)
2192 uzder(1,3,2)= dc_norm(2,i)
2193 uzder(2,3,2)=-dc_norm(1,i)
2195 C Compute the Y-axis
2198 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2200 C Compute the derivatives of uy
2203 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2204 & -dc_norm(k,i)*dc_norm(j,i-1)
2205 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2207 uyder(j,j,1)=uyder(j,j,1)-costh
2208 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2213 uygrad(l,k,j,i)=uyder(l,k,j)
2214 uzgrad(l,k,j,i)=uzder(l,k,j)
2218 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2219 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2220 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2221 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2224 C Compute the Z-axis
2225 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2226 costh=dcos(pi-theta(i+2))
2227 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2231 C Compute the derivatives of uz
2233 uzder(2,1,1)=-dc_norm(3,i+1)
2234 uzder(3,1,1)= dc_norm(2,i+1)
2235 uzder(1,2,1)= dc_norm(3,i+1)
2237 uzder(3,2,1)=-dc_norm(1,i+1)
2238 uzder(1,3,1)=-dc_norm(2,i+1)
2239 uzder(2,3,1)= dc_norm(1,i+1)
2242 uzder(2,1,2)= dc_norm(3,i)
2243 uzder(3,1,2)=-dc_norm(2,i)
2244 uzder(1,2,2)=-dc_norm(3,i)
2246 uzder(3,2,2)= dc_norm(1,i)
2247 uzder(1,3,2)= dc_norm(2,i)
2248 uzder(2,3,2)=-dc_norm(1,i)
2250 C Compute the Y-axis
2253 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2255 C Compute the derivatives of uy
2258 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2259 & -dc_norm(k,i)*dc_norm(j,i+1)
2260 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2262 uyder(j,j,1)=uyder(j,j,1)-costh
2263 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2268 uygrad(l,k,j,i)=uyder(l,k,j)
2269 uzgrad(l,k,j,i)=uzder(l,k,j)
2273 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2274 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2275 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2276 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2280 vbld_inv_temp(1)=vbld_inv(i+1)
2281 if (i.lt.nres-1) then
2282 vbld_inv_temp(2)=vbld_inv(i+2)
2284 vbld_inv_temp(2)=vbld_inv(i)
2289 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2290 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2295 #if defined(PARVEC) && defined(MPI)
2296 if (nfgtasks1.gt.1) then
2298 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2299 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2300 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2301 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2302 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2304 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2305 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2307 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2308 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2309 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2310 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2311 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2312 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2313 time_gather=time_gather+MPI_Wtime()-time00
2315 c if (fg_rank.eq.0) then
2316 c write (iout,*) "Arrays UY and UZ"
2318 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2325 C-----------------------------------------------------------------------------
2326 subroutine check_vecgrad
2327 implicit real*8 (a-h,o-z)
2328 include 'DIMENSIONS'
2329 include 'COMMON.IOUNITS'
2330 include 'COMMON.GEO'
2331 include 'COMMON.VAR'
2332 include 'COMMON.LOCAL'
2333 include 'COMMON.CHAIN'
2334 include 'COMMON.VECTORS'
2335 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2336 dimension uyt(3,maxres),uzt(3,maxres)
2337 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2338 double precision delta /1.0d-7/
2341 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2342 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2343 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2344 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2345 cd & (dc_norm(if90,i),if90=1,3)
2346 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2347 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2348 cd write(iout,'(a)')
2354 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2355 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2368 cd write (iout,*) 'i=',i
2370 erij(k)=dc_norm(k,i)
2374 dc_norm(k,i)=erij(k)
2376 dc_norm(j,i)=dc_norm(j,i)+delta
2377 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2379 c dc_norm(k,i)=dc_norm(k,i)/fac
2381 c write (iout,*) (dc_norm(k,i),k=1,3)
2382 c write (iout,*) (erij(k),k=1,3)
2385 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2386 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2387 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2388 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2390 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2391 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2392 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2395 dc_norm(k,i)=erij(k)
2398 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2399 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2400 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2401 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2402 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2403 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2404 cd write (iout,'(a)')
2409 C--------------------------------------------------------------------------
2410 subroutine set_matrices
2411 implicit real*8 (a-h,o-z)
2412 include 'DIMENSIONS'
2415 include "COMMON.SETUP"
2417 integer status(MPI_STATUS_SIZE)
2419 include 'COMMON.IOUNITS'
2420 include 'COMMON.GEO'
2421 include 'COMMON.VAR'
2422 include 'COMMON.LOCAL'
2423 include 'COMMON.CHAIN'
2424 include 'COMMON.DERIV'
2425 include 'COMMON.INTERACT'
2426 include 'COMMON.CONTACTS'
2427 include 'COMMON.TORSION'
2428 include 'COMMON.VECTORS'
2429 include 'COMMON.FFIELD'
2430 double precision auxvec(2),auxmat(2,2)
2432 C Compute the virtual-bond-torsional-angle dependent quantities needed
2433 C to calculate the el-loc multibody terms of various order.
2436 do i=ivec_start+2,ivec_end+2
2440 if (i .lt. nres+1) then
2477 if (i .gt. 3 .and. i .lt. nres+1) then
2478 obrot_der(1,i-2)=-sin1
2479 obrot_der(2,i-2)= cos1
2480 Ugder(1,1,i-2)= sin1
2481 Ugder(1,2,i-2)=-cos1
2482 Ugder(2,1,i-2)=-cos1
2483 Ugder(2,2,i-2)=-sin1
2486 obrot2_der(1,i-2)=-dwasin2
2487 obrot2_der(2,i-2)= dwacos2
2488 Ug2der(1,1,i-2)= dwasin2
2489 Ug2der(1,2,i-2)=-dwacos2
2490 Ug2der(2,1,i-2)=-dwacos2
2491 Ug2der(2,2,i-2)=-dwasin2
2493 obrot_der(1,i-2)=0.0d0
2494 obrot_der(2,i-2)=0.0d0
2495 Ugder(1,1,i-2)=0.0d0
2496 Ugder(1,2,i-2)=0.0d0
2497 Ugder(2,1,i-2)=0.0d0
2498 Ugder(2,2,i-2)=0.0d0
2499 obrot2_der(1,i-2)=0.0d0
2500 obrot2_der(2,i-2)=0.0d0
2501 Ug2der(1,1,i-2)=0.0d0
2502 Ug2der(1,2,i-2)=0.0d0
2503 Ug2der(2,1,i-2)=0.0d0
2504 Ug2der(2,2,i-2)=0.0d0
2506 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2507 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2508 iti = itortyp(itype(i-2))
2512 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2513 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2514 iti1 = itortyp(itype(i-1))
2518 cd write (iout,*) '*******i',i,' iti1',iti
2519 cd write (iout,*) 'b1',b1(:,iti)
2520 cd write (iout,*) 'b2',b2(:,iti)
2521 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2522 c if (i .gt. iatel_s+2) then
2523 if (i .gt. nnt+2) then
2524 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2525 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2526 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2528 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2529 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2530 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2531 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2532 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2543 DtUg2(l,k,i-2)=0.0d0
2547 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2548 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2550 muder(k,i-2)=Ub2der(k,i-2)
2552 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2553 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2554 if (itype(i-1).le.ntyp) then
2555 iti1 = itortyp(itype(i-1))
2563 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2565 cd write (iout,*) 'mu ',mu(:,i-2)
2566 cd write (iout,*) 'mu1',mu1(:,i-2)
2567 cd write (iout,*) 'mu2',mu2(:,i-2)
2568 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2570 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2571 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2572 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2573 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2574 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2575 C Vectors and matrices dependent on a single virtual-bond dihedral.
2576 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2577 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2578 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2579 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2580 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2581 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2582 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2583 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2584 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2587 C Matrices dependent on two consecutive virtual-bond dihedrals.
2588 C The order of matrices is from left to right.
2589 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2591 c do i=max0(ivec_start,2),ivec_end
2593 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2594 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2595 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2596 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2597 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2598 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2599 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2600 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2603 #if defined(MPI) && defined(PARMAT)
2605 c if (fg_rank.eq.0) then
2606 write (iout,*) "Arrays UG and UGDER before GATHER"
2608 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2609 & ((ug(l,k,i),l=1,2),k=1,2),
2610 & ((ugder(l,k,i),l=1,2),k=1,2)
2612 write (iout,*) "Arrays UG2 and UG2DER"
2614 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2615 & ((ug2(l,k,i),l=1,2),k=1,2),
2616 & ((ug2der(l,k,i),l=1,2),k=1,2)
2618 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2620 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2621 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2622 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2624 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2626 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2627 & costab(i),sintab(i),costab2(i),sintab2(i)
2629 write (iout,*) "Array MUDER"
2631 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2635 if (nfgtasks.gt.1) then
2637 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2638 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2639 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2641 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2642 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2644 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2645 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2647 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2648 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2650 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2651 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2653 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2654 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2656 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2657 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2659 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2660 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2661 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2662 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2663 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2664 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2665 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2666 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2667 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2668 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2669 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2670 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2671 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2673 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2674 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2676 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2677 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2679 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2680 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2682 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2683 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2685 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2686 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2688 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2689 & ivec_count(fg_rank1),
2690 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2692 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2693 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2695 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2696 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2698 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2699 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2701 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2702 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2704 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2705 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2707 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2708 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2710 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2711 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2713 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2714 & ivec_count(fg_rank1),
2715 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2717 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2718 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2720 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2721 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2723 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2724 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2726 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2727 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2729 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2730 & ivec_count(fg_rank1),
2731 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2733 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2734 & ivec_count(fg_rank1),
2735 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2737 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2738 & ivec_count(fg_rank1),
2739 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2740 & MPI_MAT2,FG_COMM1,IERR)
2741 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2742 & ivec_count(fg_rank1),
2743 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2744 & MPI_MAT2,FG_COMM1,IERR)
2747 c Passes matrix info through the ring
2750 if (irecv.lt.0) irecv=nfgtasks1-1
2753 if (inext.ge.nfgtasks1) inext=0
2755 c write (iout,*) "isend",isend," irecv",irecv
2757 lensend=lentyp(isend)
2758 lenrecv=lentyp(irecv)
2759 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2760 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2761 c & MPI_ROTAT1(lensend),inext,2200+isend,
2762 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2763 c & iprev,2200+irecv,FG_COMM,status,IERR)
2764 c write (iout,*) "Gather ROTAT1"
2766 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2767 c & MPI_ROTAT2(lensend),inext,3300+isend,
2768 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2769 c & iprev,3300+irecv,FG_COMM,status,IERR)
2770 c write (iout,*) "Gather ROTAT2"
2772 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2773 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2774 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2775 & iprev,4400+irecv,FG_COMM,status,IERR)
2776 c write (iout,*) "Gather ROTAT_OLD"
2778 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2779 & MPI_PRECOMP11(lensend),inext,5500+isend,
2780 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2781 & iprev,5500+irecv,FG_COMM,status,IERR)
2782 c write (iout,*) "Gather PRECOMP11"
2784 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2785 & MPI_PRECOMP12(lensend),inext,6600+isend,
2786 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2787 & iprev,6600+irecv,FG_COMM,status,IERR)
2788 c write (iout,*) "Gather PRECOMP12"
2790 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2792 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2793 & MPI_ROTAT2(lensend),inext,7700+isend,
2794 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2795 & iprev,7700+irecv,FG_COMM,status,IERR)
2796 c write (iout,*) "Gather PRECOMP21"
2798 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2799 & MPI_PRECOMP22(lensend),inext,8800+isend,
2800 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2801 & iprev,8800+irecv,FG_COMM,status,IERR)
2802 c write (iout,*) "Gather PRECOMP22"
2804 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2805 & MPI_PRECOMP23(lensend),inext,9900+isend,
2806 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2807 & MPI_PRECOMP23(lenrecv),
2808 & iprev,9900+irecv,FG_COMM,status,IERR)
2809 c write (iout,*) "Gather PRECOMP23"
2814 if (irecv.lt.0) irecv=nfgtasks1-1
2817 time_gather=time_gather+MPI_Wtime()-time00
2820 c if (fg_rank.eq.0) then
2821 write (iout,*) "Arrays UG and UGDER"
2823 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2824 & ((ug(l,k,i),l=1,2),k=1,2),
2825 & ((ugder(l,k,i),l=1,2),k=1,2)
2827 write (iout,*) "Arrays UG2 and UG2DER"
2829 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2830 & ((ug2(l,k,i),l=1,2),k=1,2),
2831 & ((ug2der(l,k,i),l=1,2),k=1,2)
2833 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2835 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2836 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2837 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2839 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2841 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2842 & costab(i),sintab(i),costab2(i),sintab2(i)
2844 write (iout,*) "Array MUDER"
2846 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2852 cd iti = itortyp(itype(i))
2855 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2856 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2861 C--------------------------------------------------------------------------
2862 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2864 C This subroutine calculates the average interaction energy and its gradient
2865 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2866 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2867 C The potential depends both on the distance of peptide-group centers and on
2868 C the orientation of the CA-CA virtual bonds.
2870 implicit real*8 (a-h,o-z)
2874 include 'DIMENSIONS'
2875 include 'COMMON.CONTROL'
2876 include 'COMMON.SETUP'
2877 include 'COMMON.IOUNITS'
2878 include 'COMMON.GEO'
2879 include 'COMMON.VAR'
2880 include 'COMMON.LOCAL'
2881 include 'COMMON.CHAIN'
2882 include 'COMMON.DERIV'
2883 include 'COMMON.INTERACT'
2884 include 'COMMON.CONTACTS'
2885 include 'COMMON.TORSION'
2886 include 'COMMON.VECTORS'
2887 include 'COMMON.FFIELD'
2888 include 'COMMON.TIME1'
2889 include 'COMMON.SPLITELE'
2890 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2891 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2892 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2893 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2894 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2895 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2897 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2899 double precision scal_el /1.0d0/
2901 double precision scal_el /0.5d0/
2904 C 13-go grudnia roku pamietnego...
2905 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2906 & 0.0d0,1.0d0,0.0d0,
2907 & 0.0d0,0.0d0,1.0d0/
2908 cd write(iout,*) 'In EELEC'
2910 cd write(iout,*) 'Type',i
2911 cd write(iout,*) 'B1',B1(:,i)
2912 cd write(iout,*) 'B2',B2(:,i)
2913 cd write(iout,*) 'CC',CC(:,:,i)
2914 cd write(iout,*) 'DD',DD(:,:,i)
2915 cd write(iout,*) 'EE',EE(:,:,i)
2917 cd call check_vecgrad
2919 if (icheckgrad.eq.1) then
2921 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2923 dc_norm(k,i)=dc(k,i)*fac
2925 c write (iout,*) 'i',i,' fac',fac
2928 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2929 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2930 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2931 c call vec_and_deriv
2937 time_mat=time_mat+MPI_Wtime()-time01
2941 cd write (iout,*) 'i=',i
2943 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2946 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2947 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2960 cd print '(a)','Enter EELEC'
2961 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2963 gel_loc_loc(i)=0.0d0
2968 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2970 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2972 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
2973 do i=iturn3_start,iturn3_end
2974 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2975 & .or. itype(i+2).eq.ntyp1
2976 & .or. itype(i+3).eq.ntyp1
2977 & .or. itype(i-1).eq.ntyp1
2978 & .or. itype(i+4).eq.ntyp1
2983 dx_normi=dc_norm(1,i)
2984 dy_normi=dc_norm(2,i)
2985 dz_normi=dc_norm(3,i)
2986 xmedi=c(1,i)+0.5d0*dxi
2987 ymedi=c(2,i)+0.5d0*dyi
2988 zmedi=c(3,i)+0.5d0*dzi
2989 xmedi=mod(xmedi,boxxsize)
2990 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2991 ymedi=mod(ymedi,boxysize)
2992 if (ymedi.lt.0) ymedi=ymedi+boxysize
2993 zmedi=mod(zmedi,boxzsize)
2994 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2996 call eelecij(i,i+2,ees,evdw1,eel_loc)
2997 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2998 num_cont_hb(i)=num_conti
3000 do i=iturn4_start,iturn4_end
3001 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3002 & .or. itype(i+3).eq.ntyp1
3003 & .or. itype(i+4).eq.ntyp1
3004 & .or. itype(i+5).eq.ntyp1
3005 & .or. itype(i).eq.ntyp1
3006 & .or. itype(i-1).eq.ntyp1
3011 dx_normi=dc_norm(1,i)
3012 dy_normi=dc_norm(2,i)
3013 dz_normi=dc_norm(3,i)
3014 xmedi=c(1,i)+0.5d0*dxi
3015 ymedi=c(2,i)+0.5d0*dyi
3016 zmedi=c(3,i)+0.5d0*dzi
3017 C Return atom into box, boxxsize is size of box in x dimension
3019 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3020 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3021 C Condition for being inside the proper box
3022 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3023 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3027 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3028 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3029 C Condition for being inside the proper box
3030 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3031 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3035 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3036 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3037 C Condition for being inside the proper box
3038 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3039 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3042 xmedi=mod(xmedi,boxxsize)
3043 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3044 ymedi=mod(ymedi,boxysize)
3045 if (ymedi.lt.0) ymedi=ymedi+boxysize
3046 zmedi=mod(zmedi,boxzsize)
3047 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3049 num_conti=num_cont_hb(i)
3050 call eelecij(i,i+3,ees,evdw1,eel_loc)
3051 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3052 & call eturn4(i,eello_turn4)
3053 num_cont_hb(i)=num_conti
3055 C Loop over all neighbouring boxes
3060 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3062 do i=iatel_s,iatel_e
3063 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3064 & .or. itype(i+2).eq.ntyp1
3065 & .or. itype(i-1).eq.ntyp1
3070 dx_normi=dc_norm(1,i)
3071 dy_normi=dc_norm(2,i)
3072 dz_normi=dc_norm(3,i)
3073 xmedi=c(1,i)+0.5d0*dxi
3074 ymedi=c(2,i)+0.5d0*dyi
3075 zmedi=c(3,i)+0.5d0*dzi
3076 xmedi=mod(xmedi,boxxsize)
3077 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3078 ymedi=mod(ymedi,boxysize)
3079 if (ymedi.lt.0) ymedi=ymedi+boxysize
3080 zmedi=mod(zmedi,boxzsize)
3081 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3082 C xmedi=xmedi+xshift*boxxsize
3083 C ymedi=ymedi+yshift*boxysize
3084 C zmedi=zmedi+zshift*boxzsize
3086 C Return tom into box, boxxsize is size of box in x dimension
3088 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3089 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3090 C Condition for being inside the proper box
3091 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3092 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3096 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3097 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3098 C Condition for being inside the proper box
3099 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3100 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3104 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3105 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3106 cC Condition for being inside the proper box
3107 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3108 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3112 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3113 num_conti=num_cont_hb(i)
3114 do j=ielstart(i),ielend(i)
3115 c write (iout,*) i,j,itype(i),itype(j)
3116 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3117 & .or.itype(j+2).eq.ntyp1
3118 & .or.itype(j-1).eq.ntyp1
3120 call eelecij(i,j,ees,evdw1,eel_loc)
3122 num_cont_hb(i)=num_conti
3128 c write (iout,*) "Number of loop steps in EELEC:",ind
3130 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3131 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3133 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3134 ccc eel_loc=eel_loc+eello_turn3
3135 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3138 C-------------------------------------------------------------------------------
3139 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3140 implicit real*8 (a-h,o-z)
3141 include 'DIMENSIONS'
3145 include 'COMMON.CONTROL'
3146 include 'COMMON.IOUNITS'
3147 include 'COMMON.GEO'
3148 include 'COMMON.VAR'
3149 include 'COMMON.LOCAL'
3150 include 'COMMON.CHAIN'
3151 include 'COMMON.DERIV'
3152 include 'COMMON.INTERACT'
3153 include 'COMMON.CONTACTS'
3154 include 'COMMON.TORSION'
3155 include 'COMMON.VECTORS'
3156 include 'COMMON.FFIELD'
3157 include 'COMMON.TIME1'
3158 include 'COMMON.SPLITELE'
3159 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3160 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3161 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3162 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3163 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3164 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3166 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3168 double precision scal_el /1.0d0/
3170 double precision scal_el /0.5d0/
3173 C 13-go grudnia roku pamietnego...
3174 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3175 & 0.0d0,1.0d0,0.0d0,
3176 & 0.0d0,0.0d0,1.0d0/
3177 c time00=MPI_Wtime()
3178 cd write (iout,*) "eelecij",i,j
3182 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3183 aaa=app(iteli,itelj)
3184 bbb=bpp(iteli,itelj)
3185 ael6i=ael6(iteli,itelj)
3186 ael3i=ael3(iteli,itelj)
3190 dx_normj=dc_norm(1,j)
3191 dy_normj=dc_norm(2,j)
3192 dz_normj=dc_norm(3,j)
3193 C xj=c(1,j)+0.5D0*dxj-xmedi
3194 C yj=c(2,j)+0.5D0*dyj-ymedi
3195 C zj=c(3,j)+0.5D0*dzj-zmedi
3200 if (xj.lt.0) xj=xj+boxxsize
3202 if (yj.lt.0) yj=yj+boxysize
3204 if (zj.lt.0) zj=zj+boxzsize
3205 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3206 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3214 xj=xj_safe+xshift*boxxsize
3215 yj=yj_safe+yshift*boxysize
3216 zj=zj_safe+zshift*boxzsize
3217 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3218 if(dist_temp.lt.dist_init) then
3228 if (isubchap.eq.1) then
3237 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3239 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3240 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3241 C Condition for being inside the proper box
3242 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3243 c & (xj.lt.((-0.5d0)*boxxsize))) then
3247 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3248 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3249 C Condition for being inside the proper box
3250 c if ((yj.gt.((0.5d0)*boxysize)).or.
3251 c & (yj.lt.((-0.5d0)*boxysize))) then
3255 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3256 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3257 C Condition for being inside the proper box
3258 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3259 c & (zj.lt.((-0.5d0)*boxzsize))) then
3262 C endif !endPBC condintion
3266 rij=xj*xj+yj*yj+zj*zj
3268 sss=sscale(sqrt(rij))
3269 sssgrad=sscagrad(sqrt(rij))
3270 c if (sss.gt.0.0d0) then
3276 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3277 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3278 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3279 fac=cosa-3.0D0*cosb*cosg
3281 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3282 if (j.eq.i+2) ev1=scal_el*ev1
3287 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3291 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3292 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3294 evdw1=evdw1+evdwij*sss
3295 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3296 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3297 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3298 cd & xmedi,ymedi,zmedi,xj,yj,zj
3300 if (energy_dec) then
3301 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3303 &,iteli,itelj,aaa,evdw1
3304 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3308 C Calculate contributions to the Cartesian gradient.
3311 facvdw=-6*rrmij*(ev1+evdwij)*sss
3312 facel=-3*rrmij*(el1+eesij)
3318 * Radial derivatives. First process both termini of the fragment (i,j)
3324 c ghalf=0.5D0*ggg(k)
3325 c gelc(k,i)=gelc(k,i)+ghalf
3326 c gelc(k,j)=gelc(k,j)+ghalf
3328 c 9/28/08 AL Gradient compotents will be summed only at the end
3330 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3331 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3334 * Loop over residues i+1 thru j-1.
3338 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3341 if (sss.gt.0.0) then
3342 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3343 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3344 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3351 c ghalf=0.5D0*ggg(k)
3352 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3353 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3355 c 9/28/08 AL Gradient compotents will be summed only at the end
3357 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3358 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3361 * Loop over residues i+1 thru j-1.
3365 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3370 facvdw=(ev1+evdwij)*sss
3373 fac=-3*rrmij*(facvdw+facvdw+facel)
3378 * Radial derivatives. First process both termini of the fragment (i,j)
3384 c ghalf=0.5D0*ggg(k)
3385 c gelc(k,i)=gelc(k,i)+ghalf
3386 c gelc(k,j)=gelc(k,j)+ghalf
3388 c 9/28/08 AL Gradient compotents will be summed only at the end
3390 gelc_long(k,j)=gelc(k,j)+ggg(k)
3391 gelc_long(k,i)=gelc(k,i)-ggg(k)
3394 * Loop over residues i+1 thru j-1.
3398 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3401 c 9/28/08 AL Gradient compotents will be summed only at the end
3402 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3403 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3404 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3406 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3407 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3413 ecosa=2.0D0*fac3*fac1+fac4
3416 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3417 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3419 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3420 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3422 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3423 cd & (dcosg(k),k=1,3)
3425 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3428 c ghalf=0.5D0*ggg(k)
3429 c gelc(k,i)=gelc(k,i)+ghalf
3430 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3431 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3432 c gelc(k,j)=gelc(k,j)+ghalf
3433 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3434 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3438 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3443 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3444 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3446 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3447 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3448 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3449 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3453 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3454 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3455 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3457 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3458 C energy of a peptide unit is assumed in the form of a second-order
3459 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3460 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3461 C are computed for EVERY pair of non-contiguous peptide groups.
3463 if (j.lt.nres-1) then
3474 muij(kkk)=mu(k,i)*mu(l,j)
3477 cd write (iout,*) 'EELEC: i',i,' j',j
3478 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3479 cd write(iout,*) 'muij',muij
3480 ury=scalar(uy(1,i),erij)
3481 urz=scalar(uz(1,i),erij)
3482 vry=scalar(uy(1,j),erij)
3483 vrz=scalar(uz(1,j),erij)
3484 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3485 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3486 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3487 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3488 fac=dsqrt(-ael6i)*r3ij
3493 cd write (iout,'(4i5,4f10.5)')
3494 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3495 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3496 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3497 cd & uy(:,j),uz(:,j)
3498 cd write (iout,'(4f10.5)')
3499 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3500 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3501 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3502 cd write (iout,'(9f10.5/)')
3503 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3504 C Derivatives of the elements of A in virtual-bond vectors
3505 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3507 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3508 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3509 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3510 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3511 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3512 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3513 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3514 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3515 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3516 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3517 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3518 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3520 C Compute radial contributions to the gradient
3538 C Add the contributions coming from er
3541 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3542 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3543 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3544 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3547 C Derivatives in DC(i)
3548 cgrad ghalf1=0.5d0*agg(k,1)
3549 cgrad ghalf2=0.5d0*agg(k,2)
3550 cgrad ghalf3=0.5d0*agg(k,3)
3551 cgrad ghalf4=0.5d0*agg(k,4)
3552 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3553 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3554 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3555 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3556 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3557 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3558 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3559 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3560 C Derivatives in DC(i+1)
3561 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3562 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3563 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3564 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3565 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3566 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3567 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3568 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3569 C Derivatives in DC(j)
3570 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3571 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3572 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3573 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3574 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3575 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3576 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3577 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3578 C Derivatives in DC(j+1) or DC(nres-1)
3579 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3580 & -3.0d0*vryg(k,3)*ury)
3581 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3582 & -3.0d0*vrzg(k,3)*ury)
3583 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3584 & -3.0d0*vryg(k,3)*urz)
3585 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3586 & -3.0d0*vrzg(k,3)*urz)
3587 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3589 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3602 aggi(k,l)=-aggi(k,l)
3603 aggi1(k,l)=-aggi1(k,l)
3604 aggj(k,l)=-aggj(k,l)
3605 aggj1(k,l)=-aggj1(k,l)
3608 if (j.lt.nres-1) then
3614 aggi(k,l)=-aggi(k,l)
3615 aggi1(k,l)=-aggi1(k,l)
3616 aggj(k,l)=-aggj(k,l)
3617 aggj1(k,l)=-aggj1(k,l)
3628 aggi(k,l)=-aggi(k,l)
3629 aggi1(k,l)=-aggi1(k,l)
3630 aggj(k,l)=-aggj(k,l)
3631 aggj1(k,l)=-aggj1(k,l)
3636 IF (wel_loc.gt.0.0d0) THEN
3637 C Contribution to the local-electrostatic energy coming from the i-j pair
3638 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3640 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3641 c & ' eel_loc_ij',eel_loc_ij
3643 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3644 & 'eelloc',i,j,eel_loc_ij
3645 c if (eel_loc_ij.ne.0)
3646 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3647 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3649 eel_loc=eel_loc+eel_loc_ij
3650 C Partial derivatives in virtual-bond dihedral angles gamma
3652 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3653 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3654 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3655 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3656 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3657 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3658 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3660 ggg(l)=agg(l,1)*muij(1)+
3661 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3662 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3663 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3664 cgrad ghalf=0.5d0*ggg(l)
3665 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3666 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3670 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3673 C Remaining derivatives of eello
3675 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3676 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3677 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3678 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3679 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3680 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3681 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3682 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3685 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3686 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3687 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3688 & .and. num_conti.le.maxconts) then
3689 c write (iout,*) i,j," entered corr"
3691 C Calculate the contact function. The ith column of the array JCONT will
3692 C contain the numbers of atoms that make contacts with the atom I (of numbers
3693 C greater than I). The arrays FACONT and GACONT will contain the values of
3694 C the contact function and its derivative.
3695 c r0ij=1.02D0*rpp(iteli,itelj)
3696 c r0ij=1.11D0*rpp(iteli,itelj)
3697 r0ij=2.20D0*rpp(iteli,itelj)
3698 c r0ij=1.55D0*rpp(iteli,itelj)
3699 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3700 if (fcont.gt.0.0D0) then
3701 num_conti=num_conti+1
3702 if (num_conti.gt.maxconts) then
3703 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3704 & ' will skip next contacts for this conf.'
3706 jcont_hb(num_conti,i)=j
3707 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3708 cd & " jcont_hb",jcont_hb(num_conti,i)
3709 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3710 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3711 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3713 d_cont(num_conti,i)=rij
3714 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3715 C --- Electrostatic-interaction matrix ---
3716 a_chuj(1,1,num_conti,i)=a22
3717 a_chuj(1,2,num_conti,i)=a23
3718 a_chuj(2,1,num_conti,i)=a32
3719 a_chuj(2,2,num_conti,i)=a33
3720 C --- Gradient of rij
3722 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3729 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3730 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3731 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3732 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3733 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3738 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3739 C Calculate contact energies
3741 wij=cosa-3.0D0*cosb*cosg
3744 c fac3=dsqrt(-ael6i)/r0ij**3
3745 fac3=dsqrt(-ael6i)*r3ij
3746 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3747 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3748 if (ees0tmp.gt.0) then
3749 ees0pij=dsqrt(ees0tmp)
3753 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3754 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3755 if (ees0tmp.gt.0) then
3756 ees0mij=dsqrt(ees0tmp)
3761 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3762 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3763 C Diagnostics. Comment out or remove after debugging!
3764 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3765 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3766 c ees0m(num_conti,i)=0.0D0
3768 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3769 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3770 C Angular derivatives of the contact function
3771 ees0pij1=fac3/ees0pij
3772 ees0mij1=fac3/ees0mij
3773 fac3p=-3.0D0*fac3*rrmij
3774 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3775 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3777 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3778 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3779 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3780 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3781 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3782 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3783 ecosap=ecosa1+ecosa2
3784 ecosbp=ecosb1+ecosb2
3785 ecosgp=ecosg1+ecosg2
3786 ecosam=ecosa1-ecosa2
3787 ecosbm=ecosb1-ecosb2
3788 ecosgm=ecosg1-ecosg2
3797 facont_hb(num_conti,i)=fcont
3798 fprimcont=fprimcont/rij
3799 cd facont_hb(num_conti,i)=1.0D0
3800 C Following line is for diagnostics.
3803 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3804 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3807 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3808 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3810 gggp(1)=gggp(1)+ees0pijp*xj
3811 gggp(2)=gggp(2)+ees0pijp*yj
3812 gggp(3)=gggp(3)+ees0pijp*zj
3813 gggm(1)=gggm(1)+ees0mijp*xj
3814 gggm(2)=gggm(2)+ees0mijp*yj
3815 gggm(3)=gggm(3)+ees0mijp*zj
3816 C Derivatives due to the contact function
3817 gacont_hbr(1,num_conti,i)=fprimcont*xj
3818 gacont_hbr(2,num_conti,i)=fprimcont*yj
3819 gacont_hbr(3,num_conti,i)=fprimcont*zj
3822 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3823 c following the change of gradient-summation algorithm.
3825 cgrad ghalfp=0.5D0*gggp(k)
3826 cgrad ghalfm=0.5D0*gggm(k)
3827 gacontp_hb1(k,num_conti,i)=!ghalfp
3828 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3829 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3830 gacontp_hb2(k,num_conti,i)=!ghalfp
3831 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3832 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3833 gacontp_hb3(k,num_conti,i)=gggp(k)
3834 gacontm_hb1(k,num_conti,i)=!ghalfm
3835 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3836 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3837 gacontm_hb2(k,num_conti,i)=!ghalfm
3838 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3839 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3840 gacontm_hb3(k,num_conti,i)=gggm(k)
3842 C Diagnostics. Comment out or remove after debugging!
3844 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3845 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3846 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3847 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3848 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3849 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3852 endif ! num_conti.le.maxconts
3855 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3858 ghalf=0.5d0*agg(l,k)
3859 aggi(l,k)=aggi(l,k)+ghalf
3860 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3861 aggj(l,k)=aggj(l,k)+ghalf
3864 if (j.eq.nres-1 .and. i.lt.j-2) then
3867 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3872 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3875 C-----------------------------------------------------------------------------
3876 subroutine eturn3(i,eello_turn3)
3877 C Third- and fourth-order contributions from turns
3878 implicit real*8 (a-h,o-z)
3879 include 'DIMENSIONS'
3880 include 'COMMON.IOUNITS'
3881 include 'COMMON.GEO'
3882 include 'COMMON.VAR'
3883 include 'COMMON.LOCAL'
3884 include 'COMMON.CHAIN'
3885 include 'COMMON.DERIV'
3886 include 'COMMON.INTERACT'
3887 include 'COMMON.CONTACTS'
3888 include 'COMMON.TORSION'
3889 include 'COMMON.VECTORS'
3890 include 'COMMON.FFIELD'
3891 include 'COMMON.CONTROL'
3893 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3894 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3895 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3896 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3897 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3898 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3899 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3902 c write (iout,*) "eturn3",i,j,j1,j2
3907 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3909 C Third-order contributions
3916 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3917 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3918 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3919 call transpose2(auxmat(1,1),auxmat1(1,1))
3920 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3921 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3922 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3923 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3924 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3925 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3926 cd & ' eello_turn3_num',4*eello_turn3_num
3927 C Derivatives in gamma(i)
3928 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3929 call transpose2(auxmat2(1,1),auxmat3(1,1))
3930 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3931 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3932 C Derivatives in gamma(i+1)
3933 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3934 call transpose2(auxmat2(1,1),auxmat3(1,1))
3935 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3936 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3937 & +0.5d0*(pizda(1,1)+pizda(2,2))
3938 C Cartesian derivatives
3940 c ghalf1=0.5d0*agg(l,1)
3941 c ghalf2=0.5d0*agg(l,2)
3942 c ghalf3=0.5d0*agg(l,3)
3943 c ghalf4=0.5d0*agg(l,4)
3944 a_temp(1,1)=aggi(l,1)!+ghalf1
3945 a_temp(1,2)=aggi(l,2)!+ghalf2
3946 a_temp(2,1)=aggi(l,3)!+ghalf3
3947 a_temp(2,2)=aggi(l,4)!+ghalf4
3948 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3949 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3950 & +0.5d0*(pizda(1,1)+pizda(2,2))
3951 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3952 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3953 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3954 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3955 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3956 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3957 & +0.5d0*(pizda(1,1)+pizda(2,2))
3958 a_temp(1,1)=aggj(l,1)!+ghalf1
3959 a_temp(1,2)=aggj(l,2)!+ghalf2
3960 a_temp(2,1)=aggj(l,3)!+ghalf3
3961 a_temp(2,2)=aggj(l,4)!+ghalf4
3962 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3963 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3964 & +0.5d0*(pizda(1,1)+pizda(2,2))
3965 a_temp(1,1)=aggj1(l,1)
3966 a_temp(1,2)=aggj1(l,2)
3967 a_temp(2,1)=aggj1(l,3)
3968 a_temp(2,2)=aggj1(l,4)
3969 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3970 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3971 & +0.5d0*(pizda(1,1)+pizda(2,2))
3975 C-------------------------------------------------------------------------------
3976 subroutine eturn4(i,eello_turn4)
3977 C Third- and fourth-order contributions from turns
3978 implicit real*8 (a-h,o-z)
3979 include 'DIMENSIONS'
3980 include 'COMMON.IOUNITS'
3981 include 'COMMON.GEO'
3982 include 'COMMON.VAR'
3983 include 'COMMON.LOCAL'
3984 include 'COMMON.CHAIN'
3985 include 'COMMON.DERIV'
3986 include 'COMMON.INTERACT'
3987 include 'COMMON.CONTACTS'
3988 include 'COMMON.TORSION'
3989 include 'COMMON.VECTORS'
3990 include 'COMMON.FFIELD'
3991 include 'COMMON.CONTROL'
3993 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3994 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3995 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3996 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3997 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3998 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3999 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4002 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4004 C Fourth-order contributions
4012 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4013 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4014 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4019 iti1=itortyp(itype(i+1))
4020 iti2=itortyp(itype(i+2))
4021 iti3=itortyp(itype(i+3))
4022 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4023 call transpose2(EUg(1,1,i+1),e1t(1,1))
4024 call transpose2(Eug(1,1,i+2),e2t(1,1))
4025 call transpose2(Eug(1,1,i+3),e3t(1,1))
4026 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4027 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4028 s1=scalar2(b1(1,iti2),auxvec(1))
4029 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4030 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4031 s2=scalar2(b1(1,iti1),auxvec(1))
4032 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4033 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4034 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4035 eello_turn4=eello_turn4-(s1+s2+s3)
4036 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4037 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4038 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4039 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4040 cd & ' eello_turn4_num',8*eello_turn4_num
4041 C Derivatives in gamma(i)
4042 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4043 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4044 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4045 s1=scalar2(b1(1,iti2),auxvec(1))
4046 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4047 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4048 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4049 C Derivatives in gamma(i+1)
4050 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4051 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4052 s2=scalar2(b1(1,iti1),auxvec(1))
4053 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4054 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4055 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4056 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4057 C Derivatives in gamma(i+2)
4058 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4059 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4060 s1=scalar2(b1(1,iti2),auxvec(1))
4061 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4062 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4063 s2=scalar2(b1(1,iti1),auxvec(1))
4064 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4065 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4066 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4067 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4068 C Cartesian derivatives
4069 C Derivatives of this turn contributions in DC(i+2)
4070 if (j.lt.nres-1) then
4072 a_temp(1,1)=agg(l,1)
4073 a_temp(1,2)=agg(l,2)
4074 a_temp(2,1)=agg(l,3)
4075 a_temp(2,2)=agg(l,4)
4076 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4077 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4078 s1=scalar2(b1(1,iti2),auxvec(1))
4079 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4080 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4081 s2=scalar2(b1(1,iti1),auxvec(1))
4082 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4083 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4084 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4086 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4089 C Remaining derivatives of this turn contribution
4091 a_temp(1,1)=aggi(l,1)
4092 a_temp(1,2)=aggi(l,2)
4093 a_temp(2,1)=aggi(l,3)
4094 a_temp(2,2)=aggi(l,4)
4095 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4096 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4097 s1=scalar2(b1(1,iti2),auxvec(1))
4098 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4099 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4100 s2=scalar2(b1(1,iti1),auxvec(1))
4101 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4102 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4103 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4104 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4105 a_temp(1,1)=aggi1(l,1)
4106 a_temp(1,2)=aggi1(l,2)
4107 a_temp(2,1)=aggi1(l,3)
4108 a_temp(2,2)=aggi1(l,4)
4109 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4110 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4111 s1=scalar2(b1(1,iti2),auxvec(1))
4112 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4113 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4114 s2=scalar2(b1(1,iti1),auxvec(1))
4115 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4116 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4117 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4118 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4119 a_temp(1,1)=aggj(l,1)
4120 a_temp(1,2)=aggj(l,2)
4121 a_temp(2,1)=aggj(l,3)
4122 a_temp(2,2)=aggj(l,4)
4123 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4124 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4125 s1=scalar2(b1(1,iti2),auxvec(1))
4126 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4127 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4128 s2=scalar2(b1(1,iti1),auxvec(1))
4129 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4130 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4131 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4132 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4133 a_temp(1,1)=aggj1(l,1)
4134 a_temp(1,2)=aggj1(l,2)
4135 a_temp(2,1)=aggj1(l,3)
4136 a_temp(2,2)=aggj1(l,4)
4137 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4138 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4139 s1=scalar2(b1(1,iti2),auxvec(1))
4140 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4141 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4142 s2=scalar2(b1(1,iti1),auxvec(1))
4143 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4144 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4145 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4146 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4147 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4151 C-----------------------------------------------------------------------------
4152 subroutine vecpr(u,v,w)
4153 implicit real*8(a-h,o-z)
4154 dimension u(3),v(3),w(3)
4155 w(1)=u(2)*v(3)-u(3)*v(2)
4156 w(2)=-u(1)*v(3)+u(3)*v(1)
4157 w(3)=u(1)*v(2)-u(2)*v(1)
4160 C-----------------------------------------------------------------------------
4161 subroutine unormderiv(u,ugrad,unorm,ungrad)
4162 C This subroutine computes the derivatives of a normalized vector u, given
4163 C the derivatives computed without normalization conditions, ugrad. Returns
4166 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4167 double precision vec(3)
4168 double precision scalar
4170 c write (2,*) 'ugrad',ugrad
4173 vec(i)=scalar(ugrad(1,i),u(1))
4175 c write (2,*) 'vec',vec
4178 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4181 c write (2,*) 'ungrad',ungrad
4184 C-----------------------------------------------------------------------------
4185 subroutine escp_soft_sphere(evdw2,evdw2_14)
4187 C This subroutine calculates the excluded-volume interaction energy between
4188 C peptide-group centers and side chains and its gradient in virtual-bond and
4189 C side-chain vectors.
4191 implicit real*8 (a-h,o-z)
4192 include 'DIMENSIONS'
4193 include 'COMMON.GEO'
4194 include 'COMMON.VAR'
4195 include 'COMMON.LOCAL'
4196 include 'COMMON.CHAIN'
4197 include 'COMMON.DERIV'
4198 include 'COMMON.INTERACT'
4199 include 'COMMON.FFIELD'
4200 include 'COMMON.IOUNITS'
4201 include 'COMMON.CONTROL'
4206 cd print '(a)','Enter ESCP'
4207 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4211 do i=iatscp_s,iatscp_e
4212 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4214 xi=0.5D0*(c(1,i)+c(1,i+1))
4215 yi=0.5D0*(c(2,i)+c(2,i+1))
4216 zi=0.5D0*(c(3,i)+c(3,i+1))
4217 C Return atom into box, boxxsize is size of box in x dimension
4219 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4220 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4221 C Condition for being inside the proper box
4222 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4223 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4227 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4228 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4229 C Condition for being inside the proper box
4230 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4231 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4235 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4236 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4237 cC Condition for being inside the proper box
4238 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4239 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4243 if (xi.lt.0) xi=xi+boxxsize
4245 if (yi.lt.0) yi=yi+boxysize
4247 if (zi.lt.0) zi=zi+boxzsize
4248 C xi=xi+xshift*boxxsize
4249 C yi=yi+yshift*boxysize
4250 C zi=zi+zshift*boxzsize
4251 do iint=1,nscp_gr(i)
4253 do j=iscpstart(i,iint),iscpend(i,iint)
4254 if (itype(j).eq.ntyp1) cycle
4255 itypj=iabs(itype(j))
4256 C Uncomment following three lines for SC-p interactions
4260 C Uncomment following three lines for Ca-p interactions
4265 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4266 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4267 C Condition for being inside the proper box
4268 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4269 c & (xj.lt.((-0.5d0)*boxxsize))) then
4273 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4274 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4275 cC Condition for being inside the proper box
4276 c if ((yj.gt.((0.5d0)*boxysize)).or.
4277 c & (yj.lt.((-0.5d0)*boxysize))) then
4281 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4282 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4283 C Condition for being inside the proper box
4284 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4285 c & (zj.lt.((-0.5d0)*boxzsize))) then
4288 if (xj.lt.0) xj=xj+boxxsize
4290 if (yj.lt.0) yj=yj+boxysize
4292 if (zj.lt.0) zj=zj+boxzsize
4293 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4301 xj=xj_safe+xshift*boxxsize
4302 yj=yj_safe+yshift*boxysize
4303 zj=zj_safe+zshift*boxzsize
4304 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4305 if(dist_temp.lt.dist_init) then
4315 if (subchap.eq.1) then
4328 rij=xj*xj+yj*yj+zj*zj
4332 if (rij.lt.r0ijsq) then
4333 evdwij=0.25d0*(rij-r0ijsq)**2
4341 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4346 cgrad if (j.lt.i) then
4347 cd write (iout,*) 'j<i'
4348 C Uncomment following three lines for SC-p interactions
4350 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4353 cd write (iout,*) 'j>i'
4355 cgrad ggg(k)=-ggg(k)
4356 C Uncomment following line for SC-p interactions
4357 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4361 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4363 cgrad kstart=min0(i+1,j)
4364 cgrad kend=max0(i-1,j-1)
4365 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4366 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4367 cgrad do k=kstart,kend
4369 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4373 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4374 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4385 C-----------------------------------------------------------------------------
4386 subroutine escp(evdw2,evdw2_14)
4388 C This subroutine calculates the excluded-volume interaction energy between
4389 C peptide-group centers and side chains and its gradient in virtual-bond and
4390 C side-chain vectors.
4392 implicit real*8 (a-h,o-z)
4393 include 'DIMENSIONS'
4394 include 'COMMON.GEO'
4395 include 'COMMON.VAR'
4396 include 'COMMON.LOCAL'
4397 include 'COMMON.CHAIN'
4398 include 'COMMON.DERIV'
4399 include 'COMMON.INTERACT'
4400 include 'COMMON.FFIELD'
4401 include 'COMMON.IOUNITS'
4402 include 'COMMON.CONTROL'
4403 include 'COMMON.SPLITELE'
4407 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
4408 cd print '(a)','Enter ESCP'
4409 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4413 do i=iatscp_s,iatscp_e
4414 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4416 xi=0.5D0*(c(1,i)+c(1,i+1))
4417 yi=0.5D0*(c(2,i)+c(2,i+1))
4418 zi=0.5D0*(c(3,i)+c(3,i+1))
4420 if (xi.lt.0) xi=xi+boxxsize
4422 if (yi.lt.0) yi=yi+boxysize
4424 if (zi.lt.0) zi=zi+boxzsize
4425 c xi=xi+xshift*boxxsize
4426 c yi=yi+yshift*boxysize
4427 c zi=zi+zshift*boxzsize
4428 c print *,xi,yi,zi,'polozenie i'
4429 C Return atom into box, boxxsize is size of box in x dimension
4431 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4432 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4433 C Condition for being inside the proper box
4434 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4435 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4439 c print *,xi,boxxsize,"pierwszy"
4441 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4442 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4443 C Condition for being inside the proper box
4444 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4445 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4449 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4450 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4451 C Condition for being inside the proper box
4452 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4453 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4456 do iint=1,nscp_gr(i)
4458 do j=iscpstart(i,iint),iscpend(i,iint)
4459 itypj=iabs(itype(j))
4460 if (itypj.eq.ntyp1) cycle
4461 C Uncomment following three lines for SC-p interactions
4465 C Uncomment following three lines for Ca-p interactions
4470 if (xj.lt.0) xj=xj+boxxsize
4472 if (yj.lt.0) yj=yj+boxysize
4474 if (zj.lt.0) zj=zj+boxzsize
4476 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4477 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4478 C Condition for being inside the proper box
4479 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4480 c & (xj.lt.((-0.5d0)*boxxsize))) then
4484 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4485 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4486 cC Condition for being inside the proper box
4487 c if ((yj.gt.((0.5d0)*boxysize)).or.
4488 c & (yj.lt.((-0.5d0)*boxysize))) then
4492 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4493 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4494 C Condition for being inside the proper box
4495 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4496 c & (zj.lt.((-0.5d0)*boxzsize))) then
4499 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
4500 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4508 xj=xj_safe+xshift*boxxsize
4509 yj=yj_safe+yshift*boxysize
4510 zj=zj_safe+zshift*boxzsize
4511 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4512 if(dist_temp.lt.dist_init) then
4522 if (subchap.eq.1) then
4531 c print *,xj,yj,zj,'polozenie j'
4532 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4534 sss=sscale(1.0d0/(dsqrt(rrij)))
4535 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
4536 c if (sss.eq.0) print *,'czasem jest OK'
4537 if (sss.le.0.0d0) cycle
4538 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4540 e1=fac*fac*aad(itypj,iteli)
4541 e2=fac*bad(itypj,iteli)
4542 if (iabs(j-i) .le. 2) then
4545 evdw2_14=evdw2_14+(e1+e2)*sss
4548 evdw2=evdw2+evdwij*sss
4549 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4550 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4553 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4555 fac=-(evdwij+e1)*rrij*sss
4556 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4560 cgrad if (j.lt.i) then
4561 cd write (iout,*) 'j<i'
4562 C Uncomment following three lines for SC-p interactions
4564 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4567 cd write (iout,*) 'j>i'
4569 cgrad ggg(k)=-ggg(k)
4570 C Uncomment following line for SC-p interactions
4571 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4572 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4576 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4578 cgrad kstart=min0(i+1,j)
4579 cgrad kend=max0(i-1,j-1)
4580 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4581 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4582 cgrad do k=kstart,kend
4584 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4588 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4589 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4591 c endif !endif for sscale cutoff
4601 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4602 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4603 gradx_scp(j,i)=expon*gradx_scp(j,i)
4606 C******************************************************************************
4610 C To save time the factor EXPON has been extracted from ALL components
4611 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4614 C******************************************************************************
4617 C--------------------------------------------------------------------------
4618 subroutine edis(ehpb)
4620 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4622 implicit real*8 (a-h,o-z)
4623 include 'DIMENSIONS'
4624 include 'COMMON.SBRIDGE'
4625 include 'COMMON.CHAIN'
4626 include 'COMMON.DERIV'
4627 include 'COMMON.VAR'
4628 include 'COMMON.INTERACT'
4629 include 'COMMON.IOUNITS'
4632 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4633 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4634 if (link_end.eq.0) return
4635 do i=link_start,link_end
4636 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4637 C CA-CA distance used in regularization of structure.
4640 C iii and jjj point to the residues for which the distance is assigned.
4641 if (ii.gt.nres) then
4648 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4649 c & dhpb(i),dhpb1(i),forcon(i)
4650 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4651 C distance and angle dependent SS bond potential.
4652 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4653 & iabs(itype(jjj)).eq.1) then
4654 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4655 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4656 if (.not.dyn_ss .and. i.le.nss) then
4657 C 15/02/13 CC dynamic SSbond - additional check
4659 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4660 >>>>>>> f5379d3246c4bd95e946c4d35d4a1c13e329c4cb
4661 call ssbond_ene(iii,jjj,eij)
4664 cd write (iout,*) "eij",eij
4666 C Calculate the distance between the two points and its difference from the
4670 C Get the force constant corresponding to this distance.
4672 C Calculate the contribution to energy.
4673 ehpb=ehpb+waga*rdis*rdis
4675 C Evaluate gradient.
4678 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4679 cd & ' waga=',waga,' fac=',fac
4681 ggg(j)=fac*(c(j,jj)-c(j,ii))
4683 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4684 C If this is a SC-SC distance, we need to calculate the contributions to the
4685 C Cartesian gradient in the SC vectors (ghpbx).
4688 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4689 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4692 cgrad do j=iii,jjj-1
4694 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4698 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4699 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4706 C--------------------------------------------------------------------------
4707 subroutine ssbond_ene(i,j,eij)
4709 C Calculate the distance and angle dependent SS-bond potential energy
4710 C using a free-energy function derived based on RHF/6-31G** ab initio
4711 C calculations of diethyl disulfide.
4713 C A. Liwo and U. Kozlowska, 11/24/03
4715 implicit real*8 (a-h,o-z)
4716 include 'DIMENSIONS'
4717 include 'COMMON.SBRIDGE'
4718 include 'COMMON.CHAIN'
4719 include 'COMMON.DERIV'
4720 include 'COMMON.LOCAL'
4721 include 'COMMON.INTERACT'
4722 include 'COMMON.VAR'
4723 include 'COMMON.IOUNITS'
4724 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4725 itypi=iabs(itype(i))
4729 dxi=dc_norm(1,nres+i)
4730 dyi=dc_norm(2,nres+i)
4731 dzi=dc_norm(3,nres+i)
4732 c dsci_inv=dsc_inv(itypi)
4733 dsci_inv=vbld_inv(nres+i)
4734 itypj=iabs(itype(j))
4735 c dscj_inv=dsc_inv(itypj)
4736 dscj_inv=vbld_inv(nres+j)
4740 dxj=dc_norm(1,nres+j)
4741 dyj=dc_norm(2,nres+j)
4742 dzj=dc_norm(3,nres+j)
4743 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4748 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4749 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4750 om12=dxi*dxj+dyi*dyj+dzi*dzj
4752 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4753 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4759 deltat12=om2-om1+2.0d0
4761 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4762 & +akct*deltad*deltat12
4763 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4764 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4765 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4766 c & " deltat12",deltat12," eij",eij
4767 ed=2*akcm*deltad+akct*deltat12
4769 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4770 eom1=-2*akth*deltat1-pom1-om2*pom2
4771 eom2= 2*akth*deltat2+pom1-om1*pom2
4774 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4775 ghpbx(k,i)=ghpbx(k,i)-ggk
4776 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4777 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4778 ghpbx(k,j)=ghpbx(k,j)+ggk
4779 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4780 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4781 ghpbc(k,i)=ghpbc(k,i)-ggk
4782 ghpbc(k,j)=ghpbc(k,j)+ggk
4785 C Calculate the components of the gradient in DC and X
4789 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4794 C--------------------------------------------------------------------------
4795 subroutine ebond(estr)
4797 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4799 implicit real*8 (a-h,o-z)
4800 include 'DIMENSIONS'
4801 include 'COMMON.LOCAL'
4802 include 'COMMON.GEO'
4803 include 'COMMON.INTERACT'
4804 include 'COMMON.DERIV'
4805 include 'COMMON.VAR'
4806 include 'COMMON.CHAIN'
4807 include 'COMMON.IOUNITS'
4808 include 'COMMON.NAMES'
4809 include 'COMMON.FFIELD'
4810 include 'COMMON.CONTROL'
4811 include 'COMMON.SETUP'
4812 double precision u(3),ud(3)
4815 do i=ibondp_start,ibondp_end
4816 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4817 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4819 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4820 c & *dc(j,i-1)/vbld(i)
4822 c if (energy_dec) write(iout,*)
4823 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4825 C Checking if it involves dummy (NH3+ or COO-) group
4826 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4827 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
4828 diff = vbld(i)-vbldpDUM
4830 C NO vbldp0 is the equlibrium lenght of spring for peptide group
4831 diff = vbld(i)-vbldp0
4833 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
4834 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4837 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4839 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4842 estr=0.5d0*AKP*estr+estr1
4844 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4846 do i=ibond_start,ibond_end
4848 if (iti.ne.10 .and. iti.ne.ntyp1) then
4851 diff=vbld(i+nres)-vbldsc0(1,iti)
4852 if (energy_dec) write (iout,*)
4853 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4854 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4855 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4857 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4861 diff=vbld(i+nres)-vbldsc0(j,iti)
4862 ud(j)=aksc(j,iti)*diff
4863 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4877 uprod2=uprod2*u(k)*u(k)
4881 usumsqder=usumsqder+ud(j)*uprod2
4883 estr=estr+uprod/usum
4885 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4893 C--------------------------------------------------------------------------
4894 subroutine ebend(etheta)
4896 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4897 C angles gamma and its derivatives in consecutive thetas and gammas.
4899 implicit real*8 (a-h,o-z)
4900 include 'DIMENSIONS'
4901 include 'COMMON.LOCAL'
4902 include 'COMMON.GEO'
4903 include 'COMMON.INTERACT'
4904 include 'COMMON.DERIV'
4905 include 'COMMON.VAR'
4906 include 'COMMON.CHAIN'
4907 include 'COMMON.IOUNITS'
4908 include 'COMMON.NAMES'
4909 include 'COMMON.FFIELD'
4910 include 'COMMON.CONTROL'
4911 common /calcthet/ term1,term2,termm,diffak,ratak,
4912 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4913 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4914 double precision y(2),z(2)
4916 c time11=dexp(-2*time)
4919 c write (*,'(a,i2)') 'EBEND ICG=',icg
4920 do i=ithet_start,ithet_end
4921 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4922 & .or.itype(i).eq.ntyp1) cycle
4923 C Zero the energy function and its derivative at 0 or pi.
4924 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4926 ichir1=isign(1,itype(i-2))
4927 ichir2=isign(1,itype(i))
4928 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4929 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4930 if (itype(i-1).eq.10) then
4931 itype1=isign(10,itype(i-2))
4932 ichir11=isign(1,itype(i-2))
4933 ichir12=isign(1,itype(i-2))
4934 itype2=isign(10,itype(i))
4935 ichir21=isign(1,itype(i))
4936 ichir22=isign(1,itype(i))
4939 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4942 if (phii.ne.phii) phii=150.0
4952 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4955 if (phii1.ne.phii1) phii1=150.0
4967 C Calculate the "mean" value of theta from the part of the distribution
4968 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4969 C In following comments this theta will be referred to as t_c.
4970 thet_pred_mean=0.0d0
4972 athetk=athet(k,it,ichir1,ichir2)
4973 bthetk=bthet(k,it,ichir1,ichir2)
4975 athetk=athet(k,itype1,ichir11,ichir12)
4976 bthetk=bthet(k,itype2,ichir21,ichir22)
4978 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4979 c write(iout,*) 'chuj tu', y(k),z(k)
4981 dthett=thet_pred_mean*ssd
4982 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4983 C Derivatives of the "mean" values in gamma1 and gamma2.
4984 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4985 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4986 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4987 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4989 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4990 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4991 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4992 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4994 if (theta(i).gt.pi-delta) then
4995 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4997 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4998 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4999 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5001 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5003 else if (theta(i).lt.delta) then
5004 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5005 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5006 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5008 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5009 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5012 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5015 etheta=etheta+ethetai
5016 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5017 & 'ebend',i,ethetai,theta(i),itype(i)
5018 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5019 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5020 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5022 C Ufff.... We've done all this!!!
5025 C---------------------------------------------------------------------------
5026 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5028 implicit real*8 (a-h,o-z)
5029 include 'DIMENSIONS'
5030 include 'COMMON.LOCAL'
5031 include 'COMMON.IOUNITS'
5032 common /calcthet/ term1,term2,termm,diffak,ratak,
5033 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5034 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5035 C Calculate the contributions to both Gaussian lobes.
5036 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5037 C The "polynomial part" of the "standard deviation" of this part of
5038 C the distributioni.
5039 ccc write (iout,*) thetai,thet_pred_mean
5042 sig=sig*thet_pred_mean+polthet(j,it)
5044 C Derivative of the "interior part" of the "standard deviation of the"
5045 C gamma-dependent Gaussian lobe in t_c.
5046 sigtc=3*polthet(3,it)
5048 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5051 C Set the parameters of both Gaussian lobes of the distribution.
5052 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5053 fac=sig*sig+sigc0(it)
5056 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5057 sigsqtc=-4.0D0*sigcsq*sigtc
5058 c print *,i,sig,sigtc,sigsqtc
5059 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5060 sigtc=-sigtc/(fac*fac)
5061 C Following variable is sigma(t_c)**(-2)
5062 sigcsq=sigcsq*sigcsq
5064 sig0inv=1.0D0/sig0i**2
5065 delthec=thetai-thet_pred_mean
5066 delthe0=thetai-theta0i
5067 term1=-0.5D0*sigcsq*delthec*delthec
5068 term2=-0.5D0*sig0inv*delthe0*delthe0
5069 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5070 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5071 C NaNs in taking the logarithm. We extract the largest exponent which is added
5072 C to the energy (this being the log of the distribution) at the end of energy
5073 C term evaluation for this virtual-bond angle.
5074 if (term1.gt.term2) then
5076 term2=dexp(term2-termm)
5080 term1=dexp(term1-termm)
5083 C The ratio between the gamma-independent and gamma-dependent lobes of
5084 C the distribution is a Gaussian function of thet_pred_mean too.
5085 diffak=gthet(2,it)-thet_pred_mean
5086 ratak=diffak/gthet(3,it)**2
5087 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5088 C Let's differentiate it in thet_pred_mean NOW.
5090 C Now put together the distribution terms to make complete distribution.
5091 termexp=term1+ak*term2
5092 termpre=sigc+ak*sig0i
5093 C Contribution of the bending energy from this theta is just the -log of
5094 C the sum of the contributions from the two lobes and the pre-exponential
5095 C factor. Simple enough, isn't it?
5096 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5097 C write (iout,*) 'termexp',termexp,termm,termpre,i
5098 C NOW the derivatives!!!
5099 C 6/6/97 Take into account the deformation.
5100 E_theta=(delthec*sigcsq*term1
5101 & +ak*delthe0*sig0inv*term2)/termexp
5102 E_tc=((sigtc+aktc*sig0i)/termpre
5103 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5104 & aktc*term2)/termexp)
5107 c-----------------------------------------------------------------------------
5108 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5109 implicit real*8 (a-h,o-z)
5110 include 'DIMENSIONS'
5111 include 'COMMON.LOCAL'
5112 include 'COMMON.IOUNITS'
5113 common /calcthet/ term1,term2,termm,diffak,ratak,
5114 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5115 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5116 delthec=thetai-thet_pred_mean
5117 delthe0=thetai-theta0i
5118 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5119 t3 = thetai-thet_pred_mean
5123 t14 = t12+t6*sigsqtc
5125 t21 = thetai-theta0i
5131 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5132 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5133 & *(-t12*t9-ak*sig0inv*t27)
5137 C--------------------------------------------------------------------------
5138 subroutine ebend(etheta)
5140 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5141 C angles gamma and its derivatives in consecutive thetas and gammas.
5142 C ab initio-derived potentials from
5143 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5145 implicit real*8 (a-h,o-z)
5146 include 'DIMENSIONS'
5147 include 'COMMON.LOCAL'
5148 include 'COMMON.GEO'
5149 include 'COMMON.INTERACT'
5150 include 'COMMON.DERIV'
5151 include 'COMMON.VAR'
5152 include 'COMMON.CHAIN'
5153 include 'COMMON.IOUNITS'
5154 include 'COMMON.NAMES'
5155 include 'COMMON.FFIELD'
5156 include 'COMMON.CONTROL'
5157 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5158 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5159 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5160 & sinph1ph2(maxdouble,maxdouble)
5161 logical lprn /.false./, lprn1 /.false./
5163 do i=ithet_start,ithet_end
5164 c print *,i,itype(i-1),itype(i),itype(i-2)
5165 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5166 & .or.itype(i).eq.ntyp1) cycle
5167 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
5169 if (iabs(itype(i+1)).eq.20) iblock=2
5170 if (iabs(itype(i+1)).ne.20) iblock=1
5174 theti2=0.5d0*theta(i)
5175 ityp2=ithetyp((itype(i-1)))
5177 coskt(k)=dcos(k*theti2)
5178 sinkt(k)=dsin(k*theti2)
5180 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5183 if (phii.ne.phii) phii=150.0
5187 ityp1=ithetyp((itype(i-2)))
5188 C propagation of chirality for glycine type
5190 cosph1(k)=dcos(k*phii)
5191 sinph1(k)=dsin(k*phii)
5201 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5204 if (phii1.ne.phii1) phii1=150.0
5209 ityp3=ithetyp((itype(i)))
5211 cosph2(k)=dcos(k*phii1)
5212 sinph2(k)=dsin(k*phii1)
5222 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5225 ccl=cosph1(l)*cosph2(k-l)
5226 ssl=sinph1(l)*sinph2(k-l)
5227 scl=sinph1(l)*cosph2(k-l)
5228 csl=cosph1(l)*sinph2(k-l)
5229 cosph1ph2(l,k)=ccl-ssl
5230 cosph1ph2(k,l)=ccl+ssl
5231 sinph1ph2(l,k)=scl+csl
5232 sinph1ph2(k,l)=scl-csl
5236 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5237 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5238 write (iout,*) "coskt and sinkt"
5240 write (iout,*) k,coskt(k),sinkt(k)
5244 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5245 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5248 & write (iout,*) "k",k,"
5249 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5250 & " ethetai",ethetai
5253 write (iout,*) "cosph and sinph"
5255 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5257 write (iout,*) "cosph1ph2 and sinph2ph2"
5260 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5261 & sinph1ph2(l,k),sinph1ph2(k,l)
5264 write(iout,*) "ethetai",ethetai
5268 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5269 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5270 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5271 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5272 ethetai=ethetai+sinkt(m)*aux
5273 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5274 dephii=dephii+k*sinkt(m)*(
5275 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5276 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5277 dephii1=dephii1+k*sinkt(m)*(
5278 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5279 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5281 & write (iout,*) "m",m," k",k," bbthet",
5282 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5283 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5284 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5285 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5289 & write(iout,*) "ethetai",ethetai
5293 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5294 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5295 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5296 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5297 ethetai=ethetai+sinkt(m)*aux
5298 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5299 dephii=dephii+l*sinkt(m)*(
5300 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5301 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5302 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5303 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5304 dephii1=dephii1+(k-l)*sinkt(m)*(
5305 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5306 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5307 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5308 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5310 write (iout,*) "m",m," k",k," l",l," ffthet",
5311 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5312 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5313 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5314 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5315 & " ethetai",ethetai
5316 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5317 & cosph1ph2(k,l)*sinkt(m),
5318 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5326 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5327 & i,theta(i)*rad2deg,phii*rad2deg,
5328 & phii1*rad2deg,ethetai
5330 etheta=etheta+ethetai
5331 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5332 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5333 gloc(nphi+i-2,icg)=wang*dethetai+ gloc(nphi+i-2,icg)
5339 c-----------------------------------------------------------------------------
5340 subroutine esc(escloc)
5341 C Calculate the local energy of a side chain and its derivatives in the
5342 C corresponding virtual-bond valence angles THETA and the spherical angles
5344 implicit real*8 (a-h,o-z)
5345 include 'DIMENSIONS'
5346 include 'COMMON.GEO'
5347 include 'COMMON.LOCAL'
5348 include 'COMMON.VAR'
5349 include 'COMMON.INTERACT'
5350 include 'COMMON.DERIV'
5351 include 'COMMON.CHAIN'
5352 include 'COMMON.IOUNITS'
5353 include 'COMMON.NAMES'
5354 include 'COMMON.FFIELD'
5355 include 'COMMON.CONTROL'
5356 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5357 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5358 common /sccalc/ time11,time12,time112,theti,it,nlobit
5361 c write (iout,'(a)') 'ESC'
5362 do i=loc_start,loc_end
5364 if (it.eq.ntyp1) cycle
5365 if (it.eq.10) goto 1
5366 nlobit=nlob(iabs(it))
5367 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5368 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5369 theti=theta(i+1)-pipol
5374 if (x(2).gt.pi-delta) then
5378 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5380 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5381 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5383 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5384 & ddersc0(1),dersc(1))
5385 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5386 & ddersc0(3),dersc(3))
5388 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5390 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5391 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5392 & dersc0(2),esclocbi,dersc02)
5393 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5395 call splinthet(x(2),0.5d0*delta,ss,ssd)
5400 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5402 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5403 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5405 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5407 c write (iout,*) escloci
5408 else if (x(2).lt.delta) then
5412 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5414 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5415 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5417 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5418 & ddersc0(1),dersc(1))
5419 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5420 & ddersc0(3),dersc(3))
5422 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5424 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5425 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5426 & dersc0(2),esclocbi,dersc02)
5427 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5432 call splinthet(x(2),0.5d0*delta,ss,ssd)
5434 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5436 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5437 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5439 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5440 c write (iout,*) escloci
5442 call enesc(x,escloci,dersc,ddummy,.false.)
5445 escloc=escloc+escloci
5446 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5447 & 'escloc',i,escloci
5448 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5450 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5452 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5453 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5458 C---------------------------------------------------------------------------
5459 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5460 implicit real*8 (a-h,o-z)
5461 include 'DIMENSIONS'
5462 include 'COMMON.GEO'
5463 include 'COMMON.LOCAL'
5464 include 'COMMON.IOUNITS'
5465 common /sccalc/ time11,time12,time112,theti,it,nlobit
5466 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5467 double precision contr(maxlob,-1:1)
5469 c write (iout,*) 'it=',it,' nlobit=',nlobit
5473 if (mixed) ddersc(j)=0.0d0
5477 C Because of periodicity of the dependence of the SC energy in omega we have
5478 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5479 C To avoid underflows, first compute & store the exponents.
5487 z(k)=x(k)-censc(k,j,it)
5492 Axk=Axk+gaussc(l,k,j,it)*z(l)
5498 expfac=expfac+Ax(k,j,iii)*z(k)
5506 C As in the case of ebend, we want to avoid underflows in exponentiation and
5507 C subsequent NaNs and INFs in energy calculation.
5508 C Find the largest exponent
5512 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5516 cd print *,'it=',it,' emin=',emin
5518 C Compute the contribution to SC energy and derivatives
5523 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5524 if(adexp.ne.adexp) adexp=1.0
5527 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5529 cd print *,'j=',j,' expfac=',expfac
5530 escloc_i=escloc_i+expfac
5532 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5536 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5537 & +gaussc(k,2,j,it))*expfac
5544 dersc(1)=dersc(1)/cos(theti)**2
5545 ddersc(1)=ddersc(1)/cos(theti)**2
5548 escloci=-(dlog(escloc_i)-emin)
5550 dersc(j)=dersc(j)/escloc_i
5554 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5559 C------------------------------------------------------------------------------
5560 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5561 implicit real*8 (a-h,o-z)
5562 include 'DIMENSIONS'
5563 include 'COMMON.GEO'
5564 include 'COMMON.LOCAL'
5565 include 'COMMON.IOUNITS'
5566 common /sccalc/ time11,time12,time112,theti,it,nlobit
5567 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5568 double precision contr(maxlob)
5579 z(k)=x(k)-censc(k,j,it)
5585 Axk=Axk+gaussc(l,k,j,it)*z(l)
5591 expfac=expfac+Ax(k,j)*z(k)
5596 C As in the case of ebend, we want to avoid underflows in exponentiation and
5597 C subsequent NaNs and INFs in energy calculation.
5598 C Find the largest exponent
5601 if (emin.gt.contr(j)) emin=contr(j)
5605 C Compute the contribution to SC energy and derivatives
5609 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5610 escloc_i=escloc_i+expfac
5612 dersc(k)=dersc(k)+Ax(k,j)*expfac
5614 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5615 & +gaussc(1,2,j,it))*expfac
5619 dersc(1)=dersc(1)/cos(theti)**2
5620 dersc12=dersc12/cos(theti)**2
5621 escloci=-(dlog(escloc_i)-emin)
5623 dersc(j)=dersc(j)/escloc_i
5625 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5629 c----------------------------------------------------------------------------------
5630 subroutine esc(escloc)
5631 C Calculate the local energy of a side chain and its derivatives in the
5632 C corresponding virtual-bond valence angles THETA and the spherical angles
5633 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5634 C added by Urszula Kozlowska. 07/11/2007
5636 implicit real*8 (a-h,o-z)
5637 include 'DIMENSIONS'
5638 include 'COMMON.GEO'
5639 include 'COMMON.LOCAL'
5640 include 'COMMON.VAR'
5641 include 'COMMON.SCROT'
5642 include 'COMMON.INTERACT'
5643 include 'COMMON.DERIV'
5644 include 'COMMON.CHAIN'
5645 include 'COMMON.IOUNITS'
5646 include 'COMMON.NAMES'
5647 include 'COMMON.FFIELD'
5648 include 'COMMON.CONTROL'
5649 include 'COMMON.VECTORS'
5650 double precision x_prime(3),y_prime(3),z_prime(3)
5651 & , sumene,dsc_i,dp2_i,x(65),
5652 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5653 & de_dxx,de_dyy,de_dzz,de_dt
5654 double precision s1_t,s1_6_t,s2_t,s2_6_t
5656 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5657 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5658 & dt_dCi(3),dt_dCi1(3)
5659 common /sccalc/ time11,time12,time112,theti,it,nlobit
5662 do i=loc_start,loc_end
5663 if (itype(i).eq.ntyp1) cycle
5664 costtab(i+1) =dcos(theta(i+1))
5665 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5666 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5667 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5668 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5669 cosfac=dsqrt(cosfac2)
5670 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5671 sinfac=dsqrt(sinfac2)
5673 if (it.eq.10) goto 1
5675 C Compute the axes of tghe local cartesian coordinates system; store in
5676 c x_prime, y_prime and z_prime
5683 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5684 C & dc_norm(3,i+nres)
5686 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5687 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5690 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5693 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5694 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5695 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5696 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5697 c & " xy",scalar(x_prime(1),y_prime(1)),
5698 c & " xz",scalar(x_prime(1),z_prime(1)),
5699 c & " yy",scalar(y_prime(1),y_prime(1)),
5700 c & " yz",scalar(y_prime(1),z_prime(1)),
5701 c & " zz",scalar(z_prime(1),z_prime(1))
5703 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5704 C to local coordinate system. Store in xx, yy, zz.
5710 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5711 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5712 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5719 C Compute the energy of the ith side cbain
5721 c write (2,*) "xx",xx," yy",yy," zz",zz
5724 x(j) = sc_parmin(j,it)
5727 Cc diagnostics - remove later
5729 yy1 = dsin(alph(2))*dcos(omeg(2))
5730 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5731 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5732 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5734 C," --- ", xx_w,yy_w,zz_w
5737 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5738 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5740 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5741 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5743 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5744 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5745 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5746 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5747 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5749 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5750 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5751 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5752 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5753 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5755 dsc_i = 0.743d0+x(61)
5757 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5758 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5759 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5760 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5761 s1=(1+x(63))/(0.1d0 + dscp1)
5762 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5763 s2=(1+x(65))/(0.1d0 + dscp2)
5764 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5765 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5766 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5767 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5769 c & dscp1,dscp2,sumene
5770 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5771 escloc = escloc + sumene
5772 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5777 C This section to check the numerical derivatives of the energy of ith side
5778 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5779 C #define DEBUG in the code to turn it on.
5781 write (2,*) "sumene =",sumene
5785 write (2,*) xx,yy,zz
5786 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5787 de_dxx_num=(sumenep-sumene)/aincr
5789 write (2,*) "xx+ sumene from enesc=",sumenep
5792 write (2,*) xx,yy,zz
5793 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5794 de_dyy_num=(sumenep-sumene)/aincr
5796 write (2,*) "yy+ sumene from enesc=",sumenep
5799 write (2,*) xx,yy,zz
5800 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5801 de_dzz_num=(sumenep-sumene)/aincr
5803 write (2,*) "zz+ sumene from enesc=",sumenep
5804 costsave=cost2tab(i+1)
5805 sintsave=sint2tab(i+1)
5806 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5807 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5808 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5809 de_dt_num=(sumenep-sumene)/aincr
5810 write (2,*) " t+ sumene from enesc=",sumenep
5811 cost2tab(i+1)=costsave
5812 sint2tab(i+1)=sintsave
5813 C End of diagnostics section.
5816 C Compute the gradient of esc
5818 c zz=zz*dsign(1.0,dfloat(itype(i)))
5819 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5820 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5821 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5822 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5823 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5824 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5825 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5826 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5827 pom1=(sumene3*sint2tab(i+1)+sumene1)
5828 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5829 pom2=(sumene4*cost2tab(i+1)+sumene2)
5830 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5831 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5832 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5833 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5835 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5836 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5837 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5839 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5840 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5841 & +(pom1+pom2)*pom_dx
5843 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5846 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5847 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5848 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5850 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5851 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5852 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5853 & +x(59)*zz**2 +x(60)*xx*zz
5854 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5855 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5856 & +(pom1-pom2)*pom_dy
5858 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5861 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5862 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5863 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5864 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5865 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5866 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5867 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5868 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5870 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5873 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5874 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5875 & +pom1*pom_dt1+pom2*pom_dt2
5877 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5882 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5883 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5884 cosfac2xx=cosfac2*xx
5885 sinfac2yy=sinfac2*yy
5887 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5889 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5891 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5892 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5893 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5894 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5895 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5896 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5897 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5898 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5899 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5900 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5904 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5905 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5906 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5907 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5910 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5911 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5912 dZZ_XYZ(k)=vbld_inv(i+nres)*
5913 & (z_prime(k)-zz*dC_norm(k,i+nres))
5915 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5916 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5920 dXX_Ctab(k,i)=dXX_Ci(k)
5921 dXX_C1tab(k,i)=dXX_Ci1(k)
5922 dYY_Ctab(k,i)=dYY_Ci(k)
5923 dYY_C1tab(k,i)=dYY_Ci1(k)
5924 dZZ_Ctab(k,i)=dZZ_Ci(k)
5925 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5926 dXX_XYZtab(k,i)=dXX_XYZ(k)
5927 dYY_XYZtab(k,i)=dYY_XYZ(k)
5928 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5932 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5933 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5934 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5935 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5936 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5938 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5939 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5940 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5941 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5942 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5943 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5944 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5945 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5947 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5948 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5950 C to check gradient call subroutine check_grad
5956 c------------------------------------------------------------------------------
5957 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5959 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5960 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5961 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5962 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5964 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5965 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5967 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5968 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5969 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5970 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5971 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5973 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5974 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5975 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5976 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5977 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5979 dsc_i = 0.743d0+x(61)
5981 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5982 & *(xx*cost2+yy*sint2))
5983 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5984 & *(xx*cost2-yy*sint2))
5985 s1=(1+x(63))/(0.1d0 + dscp1)
5986 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5987 s2=(1+x(65))/(0.1d0 + dscp2)
5988 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5989 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5990 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5995 c------------------------------------------------------------------------------
5996 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5998 C This procedure calculates two-body contact function g(rij) and its derivative:
6001 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6004 C where x=(rij-r0ij)/delta
6006 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6009 double precision rij,r0ij,eps0ij,fcont,fprimcont
6010 double precision x,x2,x4,delta
6014 if (x.lt.-1.0D0) then
6017 else if (x.le.1.0D0) then
6020 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6021 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6028 c------------------------------------------------------------------------------
6029 subroutine splinthet(theti,delta,ss,ssder)
6030 implicit real*8 (a-h,o-z)
6031 include 'DIMENSIONS'
6032 include 'COMMON.VAR'
6033 include 'COMMON.GEO'
6036 if (theti.gt.pipol) then
6037 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6039 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6044 c------------------------------------------------------------------------------
6045 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6047 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6048 double precision ksi,ksi2,ksi3,a1,a2,a3
6049 a1=fprim0*delta/(f1-f0)
6055 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6056 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6059 c------------------------------------------------------------------------------
6060 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6062 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6063 double precision ksi,ksi2,ksi3,a1,a2,a3
6068 a2=3*(f1x-f0x)-2*fprim0x*delta
6069 a3=fprim0x*delta-2*(f1x-f0x)
6070 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6073 C-----------------------------------------------------------------------------
6075 C-----------------------------------------------------------------------------
6076 subroutine etor(etors,edihcnstr)
6077 implicit real*8 (a-h,o-z)
6078 include 'DIMENSIONS'
6079 include 'COMMON.VAR'
6080 include 'COMMON.GEO'
6081 include 'COMMON.LOCAL'
6082 include 'COMMON.TORSION'
6083 include 'COMMON.INTERACT'
6084 include 'COMMON.DERIV'
6085 include 'COMMON.CHAIN'
6086 include 'COMMON.NAMES'
6087 include 'COMMON.IOUNITS'
6088 include 'COMMON.FFIELD'
6089 include 'COMMON.TORCNSTR'
6090 include 'COMMON.CONTROL'
6092 C Set lprn=.true. for debugging
6096 do i=iphi_start,iphi_end
6098 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6099 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6100 itori=itortyp(itype(i-2))
6101 itori1=itortyp(itype(i-1))
6104 C Proline-Proline pair is a special case...
6105 if (itori.eq.3 .and. itori1.eq.3) then
6106 if (phii.gt.-dwapi3) then
6108 fac=1.0D0/(1.0D0-cosphi)
6109 etorsi=v1(1,3,3)*fac
6110 etorsi=etorsi+etorsi
6111 etors=etors+etorsi-v1(1,3,3)
6112 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6113 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6116 v1ij=v1(j+1,itori,itori1)
6117 v2ij=v2(j+1,itori,itori1)
6120 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6121 if (energy_dec) etors_ii=etors_ii+
6122 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6123 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6127 v1ij=v1(j,itori,itori1)
6128 v2ij=v2(j,itori,itori1)
6131 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6132 if (energy_dec) etors_ii=etors_ii+
6133 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6134 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6137 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6140 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6141 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6142 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6143 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6144 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6146 ! 6/20/98 - dihedral angle constraints
6149 itori=idih_constr(i)
6152 if (difi.gt.drange(i)) then
6154 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6155 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6156 else if (difi.lt.-drange(i)) then
6158 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6159 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6161 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6162 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6164 ! write (iout,*) 'edihcnstr',edihcnstr
6167 c------------------------------------------------------------------------------
6168 subroutine etor_d(etors_d)
6172 c----------------------------------------------------------------------------
6174 subroutine etor(etors,edihcnstr)
6175 implicit real*8 (a-h,o-z)
6176 include 'DIMENSIONS'
6177 include 'COMMON.VAR'
6178 include 'COMMON.GEO'
6179 include 'COMMON.LOCAL'
6180 include 'COMMON.TORSION'
6181 include 'COMMON.INTERACT'
6182 include 'COMMON.DERIV'
6183 include 'COMMON.CHAIN'
6184 include 'COMMON.NAMES'
6185 include 'COMMON.IOUNITS'
6186 include 'COMMON.FFIELD'
6187 include 'COMMON.TORCNSTR'
6188 include 'COMMON.CONTROL'
6190 C Set lprn=.true. for debugging
6194 do i=iphi_start,iphi_end
6195 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6196 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6197 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6198 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6199 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6200 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6201 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6202 C For introducing the NH3+ and COO- group please check the etor_d for reference
6205 if (iabs(itype(i)).eq.20) then
6210 itori=itortyp(itype(i-2))
6211 itori1=itortyp(itype(i-1))
6214 C Regular cosine and sine terms
6215 do j=1,nterm(itori,itori1,iblock)
6216 v1ij=v1(j,itori,itori1,iblock)
6217 v2ij=v2(j,itori,itori1,iblock)
6220 etors=etors+v1ij*cosphi+v2ij*sinphi
6221 if (energy_dec) etors_ii=etors_ii+
6222 & v1ij*cosphi+v2ij*sinphi
6223 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6227 C E = SUM ----------------------------------- - v1
6228 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6230 cosphi=dcos(0.5d0*phii)
6231 sinphi=dsin(0.5d0*phii)
6232 do j=1,nlor(itori,itori1,iblock)
6233 vl1ij=vlor1(j,itori,itori1)
6234 vl2ij=vlor2(j,itori,itori1)
6235 vl3ij=vlor3(j,itori,itori1)
6236 pom=vl2ij*cosphi+vl3ij*sinphi
6237 pom1=1.0d0/(pom*pom+1.0d0)
6238 etors=etors+vl1ij*pom1
6239 if (energy_dec) etors_ii=etors_ii+
6242 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6244 C Subtract the constant term
6245 etors=etors-v0(itori,itori1,iblock)
6246 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6247 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6249 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6250 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6251 & (v1(j,itori,itori1,iblock),j=1,6),
6252 & (v2(j,itori,itori1,iblock),j=1,6)
6253 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6254 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6256 ! 6/20/98 - dihedral angle constraints
6258 c do i=1,ndih_constr
6259 do i=idihconstr_start,idihconstr_end
6260 itori=idih_constr(i)
6262 difi=pinorm(phii-phi0(i))
6263 if (difi.gt.drange(i)) then
6265 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6266 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6267 else if (difi.lt.-drange(i)) then
6269 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6270 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6274 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6275 cd & rad2deg*phi0(i), rad2deg*drange(i),
6276 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6278 cd write (iout,*) 'edihcnstr',edihcnstr
6281 c----------------------------------------------------------------------------
6282 subroutine etor_d(etors_d)
6283 C 6/23/01 Compute double torsional energy
6284 implicit real*8 (a-h,o-z)
6285 include 'DIMENSIONS'
6286 include 'COMMON.VAR'
6287 include 'COMMON.GEO'
6288 include 'COMMON.LOCAL'
6289 include 'COMMON.TORSION'
6290 include 'COMMON.INTERACT'
6291 include 'COMMON.DERIV'
6292 include 'COMMON.CHAIN'
6293 include 'COMMON.NAMES'
6294 include 'COMMON.IOUNITS'
6295 include 'COMMON.FFIELD'
6296 include 'COMMON.TORCNSTR'
6298 C Set lprn=.true. for debugging
6302 c write(iout,*) "a tu??"
6303 do i=iphid_start,iphid_end
6304 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6305 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6306 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6307 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6308 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6309 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6310 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6311 & (itype(i+1).eq.ntyp1)) cycle
6312 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6313 itori=itortyp(itype(i-2))
6314 itori1=itortyp(itype(i-1))
6315 itori2=itortyp(itype(i))
6321 if (iabs(itype(i+1)).eq.20) iblock=2
6322 C Iblock=2 Proline type
6323 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6324 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6325 C if (itype(i+1).eq.ntyp1) iblock=3
6326 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6327 C IS or IS NOT need for this
6328 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6329 C is (itype(i-3).eq.ntyp1) ntblock=2
6330 C ntblock is N-terminal blocking group
6332 C Regular cosine and sine terms
6333 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6334 C Example of changes for NH3+ blocking group
6335 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6336 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6337 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6338 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6339 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6340 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6341 cosphi1=dcos(j*phii)
6342 sinphi1=dsin(j*phii)
6343 cosphi2=dcos(j*phii1)
6344 sinphi2=dsin(j*phii1)
6345 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6346 & v2cij*cosphi2+v2sij*sinphi2
6347 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6348 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6350 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6352 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6353 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6354 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6355 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6356 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6357 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6358 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6359 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6360 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6361 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6362 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6363 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6364 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6365 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6368 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6369 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6374 c------------------------------------------------------------------------------
6375 subroutine eback_sc_corr(esccor)
6376 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6377 c conformational states; temporarily implemented as differences
6378 c between UNRES torsional potentials (dependent on three types of
6379 c residues) and the torsional potentials dependent on all 20 types
6380 c of residues computed from AM1 energy surfaces of terminally-blocked
6381 c amino-acid residues.
6382 implicit real*8 (a-h,o-z)
6383 include 'DIMENSIONS'
6384 include 'COMMON.VAR'
6385 include 'COMMON.GEO'
6386 include 'COMMON.LOCAL'
6387 include 'COMMON.TORSION'
6388 include 'COMMON.SCCOR'
6389 include 'COMMON.INTERACT'
6390 include 'COMMON.DERIV'
6391 include 'COMMON.CHAIN'
6392 include 'COMMON.NAMES'
6393 include 'COMMON.IOUNITS'
6394 include 'COMMON.FFIELD'
6395 include 'COMMON.CONTROL'
6397 C Set lprn=.true. for debugging
6400 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6402 do i=itau_start,itau_end
6403 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6405 isccori=isccortyp(itype(i-2))
6406 isccori1=isccortyp(itype(i-1))
6407 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6409 do intertyp=1,3 !intertyp
6410 cc Added 09 May 2012 (Adasko)
6411 cc Intertyp means interaction type of backbone mainchain correlation:
6412 c 1 = SC...Ca...Ca...Ca
6413 c 2 = Ca...Ca...Ca...SC
6414 c 3 = SC...Ca...Ca...SCi
6416 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6417 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6418 & (itype(i-1).eq.ntyp1)))
6419 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6420 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6421 & .or.(itype(i).eq.ntyp1)))
6422 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6423 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6424 & (itype(i-3).eq.ntyp1)))) cycle
6425 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6426 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6428 do j=1,nterm_sccor(isccori,isccori1)
6429 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6430 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6431 cosphi=dcos(j*tauangle(intertyp,i))
6432 sinphi=dsin(j*tauangle(intertyp,i))
6433 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6434 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6436 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6437 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6439 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6440 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6441 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6442 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6443 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6449 c----------------------------------------------------------------------------
6450 subroutine multibody(ecorr)
6451 C This subroutine calculates multi-body contributions to energy following
6452 C the idea of Skolnick et al. If side chains I and J make a contact and
6453 C at the same time side chains I+1 and J+1 make a contact, an extra
6454 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6455 implicit real*8 (a-h,o-z)
6456 include 'DIMENSIONS'
6457 include 'COMMON.IOUNITS'
6458 include 'COMMON.DERIV'
6459 include 'COMMON.INTERACT'
6460 include 'COMMON.CONTACTS'
6461 double precision gx(3),gx1(3)
6464 C Set lprn=.true. for debugging
6468 write (iout,'(a)') 'Contact function values:'
6470 write (iout,'(i2,20(1x,i2,f10.5))')
6471 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6486 num_conti=num_cont(i)
6487 num_conti1=num_cont(i1)
6492 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6493 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6494 cd & ' ishift=',ishift
6495 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6496 C The system gains extra energy.
6497 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6498 endif ! j1==j+-ishift
6507 c------------------------------------------------------------------------------
6508 double precision function esccorr(i,j,k,l,jj,kk)
6509 implicit real*8 (a-h,o-z)
6510 include 'DIMENSIONS'
6511 include 'COMMON.IOUNITS'
6512 include 'COMMON.DERIV'
6513 include 'COMMON.INTERACT'
6514 include 'COMMON.CONTACTS'
6515 double precision gx(3),gx1(3)
6520 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6521 C Calculate the multi-body contribution to energy.
6522 C Calculate multi-body contributions to the gradient.
6523 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6524 cd & k,l,(gacont(m,kk,k),m=1,3)
6526 gx(m) =ekl*gacont(m,jj,i)
6527 gx1(m)=eij*gacont(m,kk,k)
6528 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6529 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6530 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6531 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6535 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6540 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6546 c------------------------------------------------------------------------------
6547 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6548 C This subroutine calculates multi-body contributions to hydrogen-bonding
6549 implicit real*8 (a-h,o-z)
6550 include 'DIMENSIONS'
6551 include 'COMMON.IOUNITS'
6554 parameter (max_cont=maxconts)
6555 parameter (max_dim=26)
6556 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6557 double precision zapas(max_dim,maxconts,max_fg_procs),
6558 & zapas_recv(max_dim,maxconts,max_fg_procs)
6559 common /przechowalnia/ zapas
6560 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6561 & status_array(MPI_STATUS_SIZE,maxconts*2)
6563 include 'COMMON.SETUP'
6564 include 'COMMON.FFIELD'
6565 include 'COMMON.DERIV'
6566 include 'COMMON.INTERACT'
6567 include 'COMMON.CONTACTS'
6568 include 'COMMON.CONTROL'
6569 include 'COMMON.LOCAL'
6570 double precision gx(3),gx1(3),time00
6573 C Set lprn=.true. for debugging
6578 if (nfgtasks.le.1) goto 30
6580 write (iout,'(a)') 'Contact function values before RECEIVE:'
6582 write (iout,'(2i3,50(1x,i2,f5.2))')
6583 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6584 & j=1,num_cont_hb(i))
6588 do i=1,ntask_cont_from
6591 do i=1,ntask_cont_to
6594 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6596 C Make the list of contacts to send to send to other procesors
6597 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6599 do i=iturn3_start,iturn3_end
6600 c write (iout,*) "make contact list turn3",i," num_cont",
6602 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6604 do i=iturn4_start,iturn4_end
6605 c write (iout,*) "make contact list turn4",i," num_cont",
6607 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6611 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6613 do j=1,num_cont_hb(i)
6616 iproc=iint_sent_local(k,jjc,ii)
6617 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6618 if (iproc.gt.0) then
6619 ncont_sent(iproc)=ncont_sent(iproc)+1
6620 nn=ncont_sent(iproc)
6622 zapas(2,nn,iproc)=jjc
6623 zapas(3,nn,iproc)=facont_hb(j,i)
6624 zapas(4,nn,iproc)=ees0p(j,i)
6625 zapas(5,nn,iproc)=ees0m(j,i)
6626 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6627 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6628 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6629 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6630 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6631 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6632 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6633 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6634 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6635 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6636 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6637 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6638 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6639 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6640 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6641 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6642 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6643 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6644 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6645 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6646 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6653 & "Numbers of contacts to be sent to other processors",
6654 & (ncont_sent(i),i=1,ntask_cont_to)
6655 write (iout,*) "Contacts sent"
6656 do ii=1,ntask_cont_to
6658 iproc=itask_cont_to(ii)
6659 write (iout,*) nn," contacts to processor",iproc,
6660 & " of CONT_TO_COMM group"
6662 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6670 CorrelID1=nfgtasks+fg_rank+1
6672 C Receive the numbers of needed contacts from other processors
6673 do ii=1,ntask_cont_from
6674 iproc=itask_cont_from(ii)
6676 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6677 & FG_COMM,req(ireq),IERR)
6679 c write (iout,*) "IRECV ended"
6681 C Send the number of contacts needed by other processors
6682 do ii=1,ntask_cont_to
6683 iproc=itask_cont_to(ii)
6685 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6686 & FG_COMM,req(ireq),IERR)
6688 c write (iout,*) "ISEND ended"
6689 c write (iout,*) "number of requests (nn)",ireq
6692 & call MPI_Waitall(ireq,req,status_array,ierr)
6694 c & "Numbers of contacts to be received from other processors",
6695 c & (ncont_recv(i),i=1,ntask_cont_from)
6699 do ii=1,ntask_cont_from
6700 iproc=itask_cont_from(ii)
6702 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6703 c & " of CONT_TO_COMM group"
6707 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6708 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6709 c write (iout,*) "ireq,req",ireq,req(ireq)
6712 C Send the contacts to processors that need them
6713 do ii=1,ntask_cont_to
6714 iproc=itask_cont_to(ii)
6716 c write (iout,*) nn," contacts to processor",iproc,
6717 c & " of CONT_TO_COMM group"
6720 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6721 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6722 c write (iout,*) "ireq,req",ireq,req(ireq)
6724 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6728 c write (iout,*) "number of requests (contacts)",ireq
6729 c write (iout,*) "req",(req(i),i=1,4)
6732 & call MPI_Waitall(ireq,req,status_array,ierr)
6733 do iii=1,ntask_cont_from
6734 iproc=itask_cont_from(iii)
6737 write (iout,*) "Received",nn," contacts from processor",iproc,
6738 & " of CONT_FROM_COMM group"
6741 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6746 ii=zapas_recv(1,i,iii)
6747 c Flag the received contacts to prevent double-counting
6748 jj=-zapas_recv(2,i,iii)
6749 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6751 nnn=num_cont_hb(ii)+1
6754 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6755 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6756 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6757 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6758 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6759 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6760 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6761 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6762 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6763 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6764 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6765 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6766 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6767 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6768 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6769 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6770 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6771 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6772 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6773 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6774 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6775 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6776 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6777 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6782 write (iout,'(a)') 'Contact function values after receive:'
6784 write (iout,'(2i3,50(1x,i3,f5.2))')
6785 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6786 & j=1,num_cont_hb(i))
6793 write (iout,'(a)') 'Contact function values:'
6795 write (iout,'(2i3,50(1x,i3,f5.2))')
6796 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6797 & j=1,num_cont_hb(i))
6801 C Remove the loop below after debugging !!!
6808 C Calculate the local-electrostatic correlation terms
6809 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6811 num_conti=num_cont_hb(i)
6812 num_conti1=num_cont_hb(i+1)
6819 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6820 c & ' jj=',jj,' kk=',kk
6821 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6822 & .or. j.lt.0 .and. j1.gt.0) .and.
6823 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6824 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6825 C The system gains extra energy.
6826 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6827 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6828 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6830 else if (j1.eq.j) then
6831 C Contacts I-J and I-(J+1) occur simultaneously.
6832 C The system loses extra energy.
6833 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6838 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6839 c & ' jj=',jj,' kk=',kk
6841 C Contacts I-J and (I+1)-J occur simultaneously.
6842 C The system loses extra energy.
6843 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6850 c------------------------------------------------------------------------------
6851 subroutine add_hb_contact(ii,jj,itask)
6852 implicit real*8 (a-h,o-z)
6853 include "DIMENSIONS"
6854 include "COMMON.IOUNITS"
6857 parameter (max_cont=maxconts)
6858 parameter (max_dim=26)
6859 include "COMMON.CONTACTS"
6860 double precision zapas(max_dim,maxconts,max_fg_procs),
6861 & zapas_recv(max_dim,maxconts,max_fg_procs)
6862 common /przechowalnia/ zapas
6863 integer i,j,ii,jj,iproc,itask(4),nn
6864 c write (iout,*) "itask",itask
6867 if (iproc.gt.0) then
6868 do j=1,num_cont_hb(ii)
6870 c write (iout,*) "i",ii," j",jj," jjc",jjc
6872 ncont_sent(iproc)=ncont_sent(iproc)+1
6873 nn=ncont_sent(iproc)
6874 zapas(1,nn,iproc)=ii
6875 zapas(2,nn,iproc)=jjc
6876 zapas(3,nn,iproc)=facont_hb(j,ii)
6877 zapas(4,nn,iproc)=ees0p(j,ii)
6878 zapas(5,nn,iproc)=ees0m(j,ii)
6879 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6880 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6881 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6882 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6883 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6884 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6885 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6886 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6887 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6888 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6889 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6890 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6891 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6892 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6893 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6894 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6895 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6896 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6897 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6898 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6899 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6907 c------------------------------------------------------------------------------
6908 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6910 C This subroutine calculates multi-body contributions to hydrogen-bonding
6911 implicit real*8 (a-h,o-z)
6912 include 'DIMENSIONS'
6913 include 'COMMON.IOUNITS'
6916 parameter (max_cont=maxconts)
6917 parameter (max_dim=70)
6918 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6919 double precision zapas(max_dim,maxconts,max_fg_procs),
6920 & zapas_recv(max_dim,maxconts,max_fg_procs)
6921 common /przechowalnia/ zapas
6922 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6923 & status_array(MPI_STATUS_SIZE,maxconts*2)
6925 include 'COMMON.SETUP'
6926 include 'COMMON.FFIELD'
6927 include 'COMMON.DERIV'
6928 include 'COMMON.LOCAL'
6929 include 'COMMON.INTERACT'
6930 include 'COMMON.CONTACTS'
6931 include 'COMMON.CHAIN'
6932 include 'COMMON.CONTROL'
6933 double precision gx(3),gx1(3)
6934 integer num_cont_hb_old(maxres)
6936 double precision eello4,eello5,eelo6,eello_turn6
6937 external eello4,eello5,eello6,eello_turn6
6938 C Set lprn=.true. for debugging
6943 num_cont_hb_old(i)=num_cont_hb(i)
6947 if (nfgtasks.le.1) goto 30
6949 write (iout,'(a)') 'Contact function values before RECEIVE:'
6951 write (iout,'(2i3,50(1x,i2,f5.2))')
6952 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6953 & j=1,num_cont_hb(i))
6957 do i=1,ntask_cont_from
6960 do i=1,ntask_cont_to
6963 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6965 C Make the list of contacts to send to send to other procesors
6966 do i=iturn3_start,iturn3_end
6967 c write (iout,*) "make contact list turn3",i," num_cont",
6969 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6971 do i=iturn4_start,iturn4_end
6972 c write (iout,*) "make contact list turn4",i," num_cont",
6974 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6978 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6980 do j=1,num_cont_hb(i)
6983 iproc=iint_sent_local(k,jjc,ii)
6984 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6985 if (iproc.ne.0) then
6986 ncont_sent(iproc)=ncont_sent(iproc)+1
6987 nn=ncont_sent(iproc)
6989 zapas(2,nn,iproc)=jjc
6990 zapas(3,nn,iproc)=d_cont(j,i)
6994 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6999 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7007 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7018 & "Numbers of contacts to be sent to other processors",
7019 & (ncont_sent(i),i=1,ntask_cont_to)
7020 write (iout,*) "Contacts sent"
7021 do ii=1,ntask_cont_to
7023 iproc=itask_cont_to(ii)
7024 write (iout,*) nn," contacts to processor",iproc,
7025 & " of CONT_TO_COMM group"
7027 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7035 CorrelID1=nfgtasks+fg_rank+1
7037 C Receive the numbers of needed contacts from other processors
7038 do ii=1,ntask_cont_from
7039 iproc=itask_cont_from(ii)
7041 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7042 & FG_COMM,req(ireq),IERR)
7044 c write (iout,*) "IRECV ended"
7046 C Send the number of contacts needed by other processors
7047 do ii=1,ntask_cont_to
7048 iproc=itask_cont_to(ii)
7050 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7051 & FG_COMM,req(ireq),IERR)
7053 c write (iout,*) "ISEND ended"
7054 c write (iout,*) "number of requests (nn)",ireq
7057 & call MPI_Waitall(ireq,req,status_array,ierr)
7059 c & "Numbers of contacts to be received from other processors",
7060 c & (ncont_recv(i),i=1,ntask_cont_from)
7064 do ii=1,ntask_cont_from
7065 iproc=itask_cont_from(ii)
7067 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7068 c & " of CONT_TO_COMM group"
7072 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7073 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7074 c write (iout,*) "ireq,req",ireq,req(ireq)
7077 C Send the contacts to processors that need them
7078 do ii=1,ntask_cont_to
7079 iproc=itask_cont_to(ii)
7081 c write (iout,*) nn," contacts to processor",iproc,
7082 c & " of CONT_TO_COMM group"
7085 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7086 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7087 c write (iout,*) "ireq,req",ireq,req(ireq)
7089 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7093 c write (iout,*) "number of requests (contacts)",ireq
7094 c write (iout,*) "req",(req(i),i=1,4)
7097 & call MPI_Waitall(ireq,req,status_array,ierr)
7098 do iii=1,ntask_cont_from
7099 iproc=itask_cont_from(iii)
7102 write (iout,*) "Received",nn," contacts from processor",iproc,
7103 & " of CONT_FROM_COMM group"
7106 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7111 ii=zapas_recv(1,i,iii)
7112 c Flag the received contacts to prevent double-counting
7113 jj=-zapas_recv(2,i,iii)
7114 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7116 nnn=num_cont_hb(ii)+1
7119 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7123 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7128 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7136 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7145 write (iout,'(a)') 'Contact function values after receive:'
7147 write (iout,'(2i3,50(1x,i3,5f6.3))')
7148 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7149 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7156 write (iout,'(a)') 'Contact function values:'
7158 write (iout,'(2i3,50(1x,i2,5f6.3))')
7159 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7160 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7166 C Remove the loop below after debugging !!!
7173 C Calculate the dipole-dipole interaction energies
7174 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7175 do i=iatel_s,iatel_e+1
7176 num_conti=num_cont_hb(i)
7185 C Calculate the local-electrostatic correlation terms
7186 c write (iout,*) "gradcorr5 in eello5 before loop"
7188 c write (iout,'(i5,3f10.5)')
7189 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7191 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7192 c write (iout,*) "corr loop i",i
7194 num_conti=num_cont_hb(i)
7195 num_conti1=num_cont_hb(i+1)
7202 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7203 c & ' jj=',jj,' kk=',kk
7204 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7205 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7206 & .or. j.lt.0 .and. j1.gt.0) .and.
7207 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7208 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7209 C The system gains extra energy.
7211 sqd1=dsqrt(d_cont(jj,i))
7212 sqd2=dsqrt(d_cont(kk,i1))
7213 sred_geom = sqd1*sqd2
7214 IF (sred_geom.lt.cutoff_corr) THEN
7215 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7217 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7218 cd & ' jj=',jj,' kk=',kk
7219 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7220 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7222 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7223 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7226 cd write (iout,*) 'sred_geom=',sred_geom,
7227 cd & ' ekont=',ekont,' fprim=',fprimcont,
7228 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7229 cd write (iout,*) "g_contij",g_contij
7230 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7231 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7232 call calc_eello(i,jp,i+1,jp1,jj,kk)
7233 if (wcorr4.gt.0.0d0)
7234 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7235 if (energy_dec.and.wcorr4.gt.0.0d0)
7236 1 write (iout,'(a6,4i5,0pf7.3)')
7237 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7238 c write (iout,*) "gradcorr5 before eello5"
7240 c write (iout,'(i5,3f10.5)')
7241 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7243 if (wcorr5.gt.0.0d0)
7244 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7245 c write (iout,*) "gradcorr5 after eello5"
7247 c write (iout,'(i5,3f10.5)')
7248 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7250 if (energy_dec.and.wcorr5.gt.0.0d0)
7251 1 write (iout,'(a6,4i5,0pf7.3)')
7252 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7253 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7254 cd write(2,*)'ijkl',i,jp,i+1,jp1
7255 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7256 & .or. wturn6.eq.0.0d0))then
7257 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7258 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7259 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7260 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7261 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7262 cd & 'ecorr6=',ecorr6
7263 cd write (iout,'(4e15.5)') sred_geom,
7264 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7265 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7266 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7267 else if (wturn6.gt.0.0d0
7268 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7269 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7270 eturn6=eturn6+eello_turn6(i,jj,kk)
7271 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7272 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7273 cd write (2,*) 'multibody_eello:eturn6',eturn6
7282 num_cont_hb(i)=num_cont_hb_old(i)
7284 c write (iout,*) "gradcorr5 in eello5"
7286 c write (iout,'(i5,3f10.5)')
7287 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7291 c------------------------------------------------------------------------------
7292 subroutine add_hb_contact_eello(ii,jj,itask)
7293 implicit real*8 (a-h,o-z)
7294 include "DIMENSIONS"
7295 include "COMMON.IOUNITS"
7298 parameter (max_cont=maxconts)
7299 parameter (max_dim=70)
7300 include "COMMON.CONTACTS"
7301 double precision zapas(max_dim,maxconts,max_fg_procs),
7302 & zapas_recv(max_dim,maxconts,max_fg_procs)
7303 common /przechowalnia/ zapas
7304 integer i,j,ii,jj,iproc,itask(4),nn
7305 c write (iout,*) "itask",itask
7308 if (iproc.gt.0) then
7309 do j=1,num_cont_hb(ii)
7311 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7313 ncont_sent(iproc)=ncont_sent(iproc)+1
7314 nn=ncont_sent(iproc)
7315 zapas(1,nn,iproc)=ii
7316 zapas(2,nn,iproc)=jjc
7317 zapas(3,nn,iproc)=d_cont(j,ii)
7321 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7326 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7334 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7346 c------------------------------------------------------------------------------
7347 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7348 implicit real*8 (a-h,o-z)
7349 include 'DIMENSIONS'
7350 include 'COMMON.IOUNITS'
7351 include 'COMMON.DERIV'
7352 include 'COMMON.INTERACT'
7353 include 'COMMON.CONTACTS'
7354 double precision gx(3),gx1(3)
7364 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7365 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7366 C Following 4 lines for diagnostics.
7371 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7372 c & 'Contacts ',i,j,
7373 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7374 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7376 C Calculate the multi-body contribution to energy.
7377 c ecorr=ecorr+ekont*ees
7378 C Calculate multi-body contributions to the gradient.
7379 coeffpees0pij=coeffp*ees0pij
7380 coeffmees0mij=coeffm*ees0mij
7381 coeffpees0pkl=coeffp*ees0pkl
7382 coeffmees0mkl=coeffm*ees0mkl
7384 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7385 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7386 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7387 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7388 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7389 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7390 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7391 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7392 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7393 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7394 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7395 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7396 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7397 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7398 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7399 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7400 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7401 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7402 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7403 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7404 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7405 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7406 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7407 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7408 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7413 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7414 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7415 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7416 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7421 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7422 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7423 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7424 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7427 c write (iout,*) "ehbcorr",ekont*ees
7432 C---------------------------------------------------------------------------
7433 subroutine dipole(i,j,jj)
7434 implicit real*8 (a-h,o-z)
7435 include 'DIMENSIONS'
7436 include 'COMMON.IOUNITS'
7437 include 'COMMON.CHAIN'
7438 include 'COMMON.FFIELD'
7439 include 'COMMON.DERIV'
7440 include 'COMMON.INTERACT'
7441 include 'COMMON.CONTACTS'
7442 include 'COMMON.TORSION'
7443 include 'COMMON.VAR'
7444 include 'COMMON.GEO'
7445 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7447 iti1 = itortyp(itype(i+1))
7448 if (j.lt.nres-1) then
7449 itj1 = itortyp(itype(j+1))
7454 dipi(iii,1)=Ub2(iii,i)
7455 dipderi(iii)=Ub2der(iii,i)
7456 dipi(iii,2)=b1(iii,iti1)
7457 dipj(iii,1)=Ub2(iii,j)
7458 dipderj(iii)=Ub2der(iii,j)
7459 dipj(iii,2)=b1(iii,itj1)
7463 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7466 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7473 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7477 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7482 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7483 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7485 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7487 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7489 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7494 C---------------------------------------------------------------------------
7495 subroutine calc_eello(i,j,k,l,jj,kk)
7497 C This subroutine computes matrices and vectors needed to calculate
7498 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7500 implicit real*8 (a-h,o-z)
7501 include 'DIMENSIONS'
7502 include 'COMMON.IOUNITS'
7503 include 'COMMON.CHAIN'
7504 include 'COMMON.DERIV'
7505 include 'COMMON.INTERACT'
7506 include 'COMMON.CONTACTS'
7507 include 'COMMON.TORSION'
7508 include 'COMMON.VAR'
7509 include 'COMMON.GEO'
7510 include 'COMMON.FFIELD'
7511 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7512 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7515 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7516 cd & ' jj=',jj,' kk=',kk
7517 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7518 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7519 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7522 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7523 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7526 call transpose2(aa1(1,1),aa1t(1,1))
7527 call transpose2(aa2(1,1),aa2t(1,1))
7530 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7531 & aa1tder(1,1,lll,kkk))
7532 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7533 & aa2tder(1,1,lll,kkk))
7537 C parallel orientation of the two CA-CA-CA frames.
7539 iti=itortyp(itype(i))
7543 itk1=itortyp(itype(k+1))
7544 itj=itortyp(itype(j))
7545 if (l.lt.nres-1) then
7546 itl1=itortyp(itype(l+1))
7550 C A1 kernel(j+1) A2T
7552 cd write (iout,'(3f10.5,5x,3f10.5)')
7553 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7555 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7556 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7557 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7558 C Following matrices are needed only for 6-th order cumulants
7559 IF (wcorr6.gt.0.0d0) THEN
7560 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7561 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7562 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7563 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7564 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7565 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7566 & ADtEAderx(1,1,1,1,1,1))
7568 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7569 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7570 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7571 & ADtEA1derx(1,1,1,1,1,1))
7573 C End 6-th order cumulants
7576 cd write (2,*) 'In calc_eello6'
7578 cd write (2,*) 'iii=',iii
7580 cd write (2,*) 'kkk=',kkk
7582 cd write (2,'(3(2f10.5),5x)')
7583 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7588 call transpose2(EUgder(1,1,k),auxmat(1,1))
7589 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7590 call transpose2(EUg(1,1,k),auxmat(1,1))
7591 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7592 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7596 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7597 & EAEAderx(1,1,lll,kkk,iii,1))
7601 C A1T kernel(i+1) A2
7602 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7603 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7604 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7605 C Following matrices are needed only for 6-th order cumulants
7606 IF (wcorr6.gt.0.0d0) THEN
7607 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7608 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7609 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7610 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7611 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7612 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7613 & ADtEAderx(1,1,1,1,1,2))
7614 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7615 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7616 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7617 & ADtEA1derx(1,1,1,1,1,2))
7619 C End 6-th order cumulants
7620 call transpose2(EUgder(1,1,l),auxmat(1,1))
7621 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7622 call transpose2(EUg(1,1,l),auxmat(1,1))
7623 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7624 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7628 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7629 & EAEAderx(1,1,lll,kkk,iii,2))
7634 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7635 C They are needed only when the fifth- or the sixth-order cumulants are
7637 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7638 call transpose2(AEA(1,1,1),auxmat(1,1))
7639 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7640 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7641 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7642 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7643 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7644 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7645 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7646 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7647 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7648 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7649 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7650 call transpose2(AEA(1,1,2),auxmat(1,1))
7651 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7652 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7653 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7654 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7655 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7656 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7657 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7658 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7659 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7660 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7661 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7662 C Calculate the Cartesian derivatives of the vectors.
7666 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7667 call matvec2(auxmat(1,1),b1(1,iti),
7668 & AEAb1derx(1,lll,kkk,iii,1,1))
7669 call matvec2(auxmat(1,1),Ub2(1,i),
7670 & AEAb2derx(1,lll,kkk,iii,1,1))
7671 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7672 & AEAb1derx(1,lll,kkk,iii,2,1))
7673 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7674 & AEAb2derx(1,lll,kkk,iii,2,1))
7675 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7676 call matvec2(auxmat(1,1),b1(1,itj),
7677 & AEAb1derx(1,lll,kkk,iii,1,2))
7678 call matvec2(auxmat(1,1),Ub2(1,j),
7679 & AEAb2derx(1,lll,kkk,iii,1,2))
7680 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7681 & AEAb1derx(1,lll,kkk,iii,2,2))
7682 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7683 & AEAb2derx(1,lll,kkk,iii,2,2))
7690 C Antiparallel orientation of the two CA-CA-CA frames.
7692 iti=itortyp(itype(i))
7696 itk1=itortyp(itype(k+1))
7697 itl=itortyp(itype(l))
7698 itj=itortyp(itype(j))
7699 if (j.lt.nres-1) then
7700 itj1=itortyp(itype(j+1))
7704 C A2 kernel(j-1)T A1T
7705 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7706 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7707 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7708 C Following matrices are needed only for 6-th order cumulants
7709 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7710 & j.eq.i+4 .and. l.eq.i+3)) THEN
7711 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7712 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7713 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7714 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7715 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7716 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7717 & ADtEAderx(1,1,1,1,1,1))
7718 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7719 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7720 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7721 & ADtEA1derx(1,1,1,1,1,1))
7723 C End 6-th order cumulants
7724 call transpose2(EUgder(1,1,k),auxmat(1,1))
7725 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7726 call transpose2(EUg(1,1,k),auxmat(1,1))
7727 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7728 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7732 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7733 & EAEAderx(1,1,lll,kkk,iii,1))
7737 C A2T kernel(i+1)T A1
7738 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7739 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7740 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7741 C Following matrices are needed only for 6-th order cumulants
7742 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7743 & j.eq.i+4 .and. l.eq.i+3)) THEN
7744 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7745 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7746 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7747 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7748 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7749 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7750 & ADtEAderx(1,1,1,1,1,2))
7751 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7752 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7753 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7754 & ADtEA1derx(1,1,1,1,1,2))
7756 C End 6-th order cumulants
7757 call transpose2(EUgder(1,1,j),auxmat(1,1))
7758 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7759 call transpose2(EUg(1,1,j),auxmat(1,1))
7760 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7761 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7765 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7766 & EAEAderx(1,1,lll,kkk,iii,2))
7771 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7772 C They are needed only when the fifth- or the sixth-order cumulants are
7774 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7775 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7776 call transpose2(AEA(1,1,1),auxmat(1,1))
7777 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7778 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7779 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7780 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7781 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7782 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7783 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7784 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7785 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7786 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7787 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7788 call transpose2(AEA(1,1,2),auxmat(1,1))
7789 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7790 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7791 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7792 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7793 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7794 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7795 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7796 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7797 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7798 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7799 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7800 C Calculate the Cartesian derivatives of the vectors.
7804 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7805 call matvec2(auxmat(1,1),b1(1,iti),
7806 & AEAb1derx(1,lll,kkk,iii,1,1))
7807 call matvec2(auxmat(1,1),Ub2(1,i),
7808 & AEAb2derx(1,lll,kkk,iii,1,1))
7809 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7810 & AEAb1derx(1,lll,kkk,iii,2,1))
7811 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7812 & AEAb2derx(1,lll,kkk,iii,2,1))
7813 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7814 call matvec2(auxmat(1,1),b1(1,itl),
7815 & AEAb1derx(1,lll,kkk,iii,1,2))
7816 call matvec2(auxmat(1,1),Ub2(1,l),
7817 & AEAb2derx(1,lll,kkk,iii,1,2))
7818 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7819 & AEAb1derx(1,lll,kkk,iii,2,2))
7820 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7821 & AEAb2derx(1,lll,kkk,iii,2,2))
7830 C---------------------------------------------------------------------------
7831 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7832 & KK,KKderg,AKA,AKAderg,AKAderx)
7836 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7837 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7838 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7843 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7845 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7848 cd if (lprn) write (2,*) 'In kernel'
7850 cd if (lprn) write (2,*) 'kkk=',kkk
7852 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7853 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7855 cd write (2,*) 'lll=',lll
7856 cd write (2,*) 'iii=1'
7858 cd write (2,'(3(2f10.5),5x)')
7859 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7862 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7863 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7865 cd write (2,*) 'lll=',lll
7866 cd write (2,*) 'iii=2'
7868 cd write (2,'(3(2f10.5),5x)')
7869 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7876 C---------------------------------------------------------------------------
7877 double precision function eello4(i,j,k,l,jj,kk)
7878 implicit real*8 (a-h,o-z)
7879 include 'DIMENSIONS'
7880 include 'COMMON.IOUNITS'
7881 include 'COMMON.CHAIN'
7882 include 'COMMON.DERIV'
7883 include 'COMMON.INTERACT'
7884 include 'COMMON.CONTACTS'
7885 include 'COMMON.TORSION'
7886 include 'COMMON.VAR'
7887 include 'COMMON.GEO'
7888 double precision pizda(2,2),ggg1(3),ggg2(3)
7889 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7893 cd print *,'eello4:',i,j,k,l,jj,kk
7894 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7895 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7896 cold eij=facont_hb(jj,i)
7897 cold ekl=facont_hb(kk,k)
7899 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7900 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7901 gcorr_loc(k-1)=gcorr_loc(k-1)
7902 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7904 gcorr_loc(l-1)=gcorr_loc(l-1)
7905 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7907 gcorr_loc(j-1)=gcorr_loc(j-1)
7908 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7913 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7914 & -EAEAderx(2,2,lll,kkk,iii,1)
7915 cd derx(lll,kkk,iii)=0.0d0
7919 cd gcorr_loc(l-1)=0.0d0
7920 cd gcorr_loc(j-1)=0.0d0
7921 cd gcorr_loc(k-1)=0.0d0
7923 cd write (iout,*)'Contacts have occurred for peptide groups',
7924 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7925 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7926 if (j.lt.nres-1) then
7933 if (l.lt.nres-1) then
7941 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7942 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7943 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7944 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7945 cgrad ghalf=0.5d0*ggg1(ll)
7946 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7947 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7948 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7949 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7950 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7951 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7952 cgrad ghalf=0.5d0*ggg2(ll)
7953 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7954 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7955 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7956 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7957 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7958 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7962 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7967 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7972 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7977 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7981 cd write (2,*) iii,gcorr_loc(iii)
7984 cd write (2,*) 'ekont',ekont
7985 cd write (iout,*) 'eello4',ekont*eel4
7988 C---------------------------------------------------------------------------
7989 double precision function eello5(i,j,k,l,jj,kk)
7990 implicit real*8 (a-h,o-z)
7991 include 'DIMENSIONS'
7992 include 'COMMON.IOUNITS'
7993 include 'COMMON.CHAIN'
7994 include 'COMMON.DERIV'
7995 include 'COMMON.INTERACT'
7996 include 'COMMON.CONTACTS'
7997 include 'COMMON.TORSION'
7998 include 'COMMON.VAR'
7999 include 'COMMON.GEO'
8000 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8001 double precision ggg1(3),ggg2(3)
8002 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8007 C /l\ / \ \ / \ / \ / C
8008 C / \ / \ \ / \ / \ / C
8009 C j| o |l1 | o | o| o | | o |o C
8010 C \ |/k\| |/ \| / |/ \| |/ \| C
8011 C \i/ \ / \ / / \ / \ C
8013 C (I) (II) (III) (IV) C
8015 C eello5_1 eello5_2 eello5_3 eello5_4 C
8017 C Antiparallel chains C
8020 C /j\ / \ \ / \ / \ / C
8021 C / \ / \ \ / \ / \ / C
8022 C j1| o |l | o | o| o | | o |o C
8023 C \ |/k\| |/ \| / |/ \| |/ \| C
8024 C \i/ \ / \ / / \ / \ C
8026 C (I) (II) (III) (IV) C
8028 C eello5_1 eello5_2 eello5_3 eello5_4 C
8030 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8032 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8033 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8038 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8040 itk=itortyp(itype(k))
8041 itl=itortyp(itype(l))
8042 itj=itortyp(itype(j))
8047 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8048 cd & eel5_3_num,eel5_4_num)
8052 derx(lll,kkk,iii)=0.0d0
8056 cd eij=facont_hb(jj,i)
8057 cd ekl=facont_hb(kk,k)
8059 cd write (iout,*)'Contacts have occurred for peptide groups',
8060 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8062 C Contribution from the graph I.
8063 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8064 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8065 call transpose2(EUg(1,1,k),auxmat(1,1))
8066 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8067 vv(1)=pizda(1,1)-pizda(2,2)
8068 vv(2)=pizda(1,2)+pizda(2,1)
8069 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8070 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8071 C Explicit gradient in virtual-dihedral angles.
8072 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8073 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8074 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8075 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8076 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8077 vv(1)=pizda(1,1)-pizda(2,2)
8078 vv(2)=pizda(1,2)+pizda(2,1)
8079 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8080 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8081 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8082 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8083 vv(1)=pizda(1,1)-pizda(2,2)
8084 vv(2)=pizda(1,2)+pizda(2,1)
8086 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8087 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8088 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8090 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8091 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8092 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8094 C Cartesian gradient
8098 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8100 vv(1)=pizda(1,1)-pizda(2,2)
8101 vv(2)=pizda(1,2)+pizda(2,1)
8102 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8103 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8104 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8110 C Contribution from graph II
8111 call transpose2(EE(1,1,itk),auxmat(1,1))
8112 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8113 vv(1)=pizda(1,1)+pizda(2,2)
8114 vv(2)=pizda(2,1)-pizda(1,2)
8115 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
8116 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8117 C Explicit gradient in virtual-dihedral angles.
8118 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8119 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8120 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8121 vv(1)=pizda(1,1)+pizda(2,2)
8122 vv(2)=pizda(2,1)-pizda(1,2)
8124 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8125 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8126 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8128 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8129 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8130 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8132 C Cartesian gradient
8136 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8138 vv(1)=pizda(1,1)+pizda(2,2)
8139 vv(2)=pizda(2,1)-pizda(1,2)
8140 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8141 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
8142 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8150 C Parallel orientation
8151 C Contribution from graph III
8152 call transpose2(EUg(1,1,l),auxmat(1,1))
8153 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8154 vv(1)=pizda(1,1)-pizda(2,2)
8155 vv(2)=pizda(1,2)+pizda(2,1)
8156 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8157 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8158 C Explicit gradient in virtual-dihedral angles.
8159 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8160 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8161 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8162 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8163 vv(1)=pizda(1,1)-pizda(2,2)
8164 vv(2)=pizda(1,2)+pizda(2,1)
8165 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8166 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8167 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8168 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8169 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8170 vv(1)=pizda(1,1)-pizda(2,2)
8171 vv(2)=pizda(1,2)+pizda(2,1)
8172 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8173 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8174 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8175 C Cartesian gradient
8179 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8181 vv(1)=pizda(1,1)-pizda(2,2)
8182 vv(2)=pizda(1,2)+pizda(2,1)
8183 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8184 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8185 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8190 C Contribution from graph IV
8192 call transpose2(EE(1,1,itl),auxmat(1,1))
8193 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8194 vv(1)=pizda(1,1)+pizda(2,2)
8195 vv(2)=pizda(2,1)-pizda(1,2)
8196 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
8197 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8198 C Explicit gradient in virtual-dihedral angles.
8199 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8200 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8201 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8202 vv(1)=pizda(1,1)+pizda(2,2)
8203 vv(2)=pizda(2,1)-pizda(1,2)
8204 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8205 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
8206 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8207 C Cartesian gradient
8211 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8213 vv(1)=pizda(1,1)+pizda(2,2)
8214 vv(2)=pizda(2,1)-pizda(1,2)
8215 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8216 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
8217 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8222 C Antiparallel orientation
8223 C Contribution from graph III
8225 call transpose2(EUg(1,1,j),auxmat(1,1))
8226 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8227 vv(1)=pizda(1,1)-pizda(2,2)
8228 vv(2)=pizda(1,2)+pizda(2,1)
8229 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8230 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8231 C Explicit gradient in virtual-dihedral angles.
8232 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8233 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8234 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8235 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8236 vv(1)=pizda(1,1)-pizda(2,2)
8237 vv(2)=pizda(1,2)+pizda(2,1)
8238 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8239 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8240 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8241 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8242 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8243 vv(1)=pizda(1,1)-pizda(2,2)
8244 vv(2)=pizda(1,2)+pizda(2,1)
8245 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8246 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8247 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8248 C Cartesian gradient
8252 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8254 vv(1)=pizda(1,1)-pizda(2,2)
8255 vv(2)=pizda(1,2)+pizda(2,1)
8256 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8257 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8258 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8263 C Contribution from graph IV
8265 call transpose2(EE(1,1,itj),auxmat(1,1))
8266 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8267 vv(1)=pizda(1,1)+pizda(2,2)
8268 vv(2)=pizda(2,1)-pizda(1,2)
8269 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
8270 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8271 C Explicit gradient in virtual-dihedral angles.
8272 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8273 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8274 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8275 vv(1)=pizda(1,1)+pizda(2,2)
8276 vv(2)=pizda(2,1)-pizda(1,2)
8277 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8278 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
8279 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8280 C Cartesian gradient
8284 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8286 vv(1)=pizda(1,1)+pizda(2,2)
8287 vv(2)=pizda(2,1)-pizda(1,2)
8288 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8289 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
8290 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8296 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8297 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8298 cd write (2,*) 'ijkl',i,j,k,l
8299 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8300 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8302 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8303 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8304 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8305 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8306 if (j.lt.nres-1) then
8313 if (l.lt.nres-1) then
8323 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8324 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8325 C summed up outside the subrouine as for the other subroutines
8326 C handling long-range interactions. The old code is commented out
8327 C with "cgrad" to keep track of changes.
8329 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8330 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8331 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8332 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8333 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8334 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8335 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8336 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8337 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8338 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8340 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8341 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8342 cgrad ghalf=0.5d0*ggg1(ll)
8344 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8345 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8346 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8347 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8348 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8349 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8350 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8351 cgrad ghalf=0.5d0*ggg2(ll)
8353 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8354 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8355 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8356 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8357 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8358 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8363 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8364 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8369 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8370 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8376 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8381 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8385 cd write (2,*) iii,g_corr5_loc(iii)
8388 cd write (2,*) 'ekont',ekont
8389 cd write (iout,*) 'eello5',ekont*eel5
8392 c--------------------------------------------------------------------------
8393 double precision function eello6(i,j,k,l,jj,kk)
8394 implicit real*8 (a-h,o-z)
8395 include 'DIMENSIONS'
8396 include 'COMMON.IOUNITS'
8397 include 'COMMON.CHAIN'
8398 include 'COMMON.DERIV'
8399 include 'COMMON.INTERACT'
8400 include 'COMMON.CONTACTS'
8401 include 'COMMON.TORSION'
8402 include 'COMMON.VAR'
8403 include 'COMMON.GEO'
8404 include 'COMMON.FFIELD'
8405 double precision ggg1(3),ggg2(3)
8406 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8411 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8419 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8420 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8424 derx(lll,kkk,iii)=0.0d0
8428 cd eij=facont_hb(jj,i)
8429 cd ekl=facont_hb(kk,k)
8435 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8436 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8437 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8438 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8439 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8440 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8442 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8443 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8444 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8445 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8446 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8447 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8451 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8453 C If turn contributions are considered, they will be handled separately.
8454 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8455 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8456 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8457 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8458 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8459 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8460 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8462 if (j.lt.nres-1) then
8469 if (l.lt.nres-1) then
8477 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8478 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8479 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8480 cgrad ghalf=0.5d0*ggg1(ll)
8482 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8483 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8484 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8485 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8486 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8487 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8488 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8489 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8490 cgrad ghalf=0.5d0*ggg2(ll)
8491 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8493 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8494 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8495 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8496 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8497 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8498 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8503 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8504 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8509 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8510 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8516 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8521 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8525 cd write (2,*) iii,g_corr6_loc(iii)
8528 cd write (2,*) 'ekont',ekont
8529 cd write (iout,*) 'eello6',ekont*eel6
8532 c--------------------------------------------------------------------------
8533 double precision function eello6_graph1(i,j,k,l,imat,swap)
8534 implicit real*8 (a-h,o-z)
8535 include 'DIMENSIONS'
8536 include 'COMMON.IOUNITS'
8537 include 'COMMON.CHAIN'
8538 include 'COMMON.DERIV'
8539 include 'COMMON.INTERACT'
8540 include 'COMMON.CONTACTS'
8541 include 'COMMON.TORSION'
8542 include 'COMMON.VAR'
8543 include 'COMMON.GEO'
8544 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8548 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8550 C Parallel Antiparallel C
8556 C \ j|/k\| / \ |/k\|l / C
8561 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8562 itk=itortyp(itype(k))
8563 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8564 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8565 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8566 call transpose2(EUgC(1,1,k),auxmat(1,1))
8567 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8568 vv1(1)=pizda1(1,1)-pizda1(2,2)
8569 vv1(2)=pizda1(1,2)+pizda1(2,1)
8570 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8571 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8572 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8573 s5=scalar2(vv(1),Dtobr2(1,i))
8574 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8575 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8576 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8577 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8578 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8579 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8580 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8581 & +scalar2(vv(1),Dtobr2der(1,i)))
8582 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8583 vv1(1)=pizda1(1,1)-pizda1(2,2)
8584 vv1(2)=pizda1(1,2)+pizda1(2,1)
8585 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8586 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8588 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8589 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8590 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8591 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8592 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8594 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8595 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8596 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8597 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8598 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8600 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8601 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8602 vv1(1)=pizda1(1,1)-pizda1(2,2)
8603 vv1(2)=pizda1(1,2)+pizda1(2,1)
8604 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8605 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8606 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8607 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8616 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8617 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8618 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8619 call transpose2(EUgC(1,1,k),auxmat(1,1))
8620 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8622 vv1(1)=pizda1(1,1)-pizda1(2,2)
8623 vv1(2)=pizda1(1,2)+pizda1(2,1)
8624 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8625 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8626 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8627 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8628 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8629 s5=scalar2(vv(1),Dtobr2(1,i))
8630 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8636 c----------------------------------------------------------------------------
8637 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8638 implicit real*8 (a-h,o-z)
8639 include 'DIMENSIONS'
8640 include 'COMMON.IOUNITS'
8641 include 'COMMON.CHAIN'
8642 include 'COMMON.DERIV'
8643 include 'COMMON.INTERACT'
8644 include 'COMMON.CONTACTS'
8645 include 'COMMON.TORSION'
8646 include 'COMMON.VAR'
8647 include 'COMMON.GEO'
8649 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8650 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8653 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8655 C Parallel Antiparallel C
8661 C \ j|/k\| \ |/k\|l C
8666 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8667 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8668 C AL 7/4/01 s1 would occur in the sixth-order moment,
8669 C but not in a cluster cumulant
8671 s1=dip(1,jj,i)*dip(1,kk,k)
8673 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8674 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8675 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8676 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8677 call transpose2(EUg(1,1,k),auxmat(1,1))
8678 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8679 vv(1)=pizda(1,1)-pizda(2,2)
8680 vv(2)=pizda(1,2)+pizda(2,1)
8681 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8682 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8684 eello6_graph2=-(s1+s2+s3+s4)
8686 eello6_graph2=-(s2+s3+s4)
8689 C Derivatives in gamma(i-1)
8692 s1=dipderg(1,jj,i)*dip(1,kk,k)
8694 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8695 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8696 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8697 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8699 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8701 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8703 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8705 C Derivatives in gamma(k-1)
8707 s1=dip(1,jj,i)*dipderg(1,kk,k)
8709 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8710 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8711 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8712 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8713 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8714 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8715 vv(1)=pizda(1,1)-pizda(2,2)
8716 vv(2)=pizda(1,2)+pizda(2,1)
8717 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8719 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8721 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8723 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8724 C Derivatives in gamma(j-1) or gamma(l-1)
8727 s1=dipderg(3,jj,i)*dip(1,kk,k)
8729 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8730 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8731 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8732 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8733 vv(1)=pizda(1,1)-pizda(2,2)
8734 vv(2)=pizda(1,2)+pizda(2,1)
8735 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8738 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8740 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8743 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8744 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8746 C Derivatives in gamma(l-1) or gamma(j-1)
8749 s1=dip(1,jj,i)*dipderg(3,kk,k)
8751 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8752 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8753 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8754 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8755 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8756 vv(1)=pizda(1,1)-pizda(2,2)
8757 vv(2)=pizda(1,2)+pizda(2,1)
8758 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8761 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8763 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8766 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8767 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8769 C Cartesian derivatives.
8771 write (2,*) 'In eello6_graph2'
8773 write (2,*) 'iii=',iii
8775 write (2,*) 'kkk=',kkk
8777 write (2,'(3(2f10.5),5x)')
8778 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8788 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8790 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8793 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8795 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8796 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8798 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8799 call transpose2(EUg(1,1,k),auxmat(1,1))
8800 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8802 vv(1)=pizda(1,1)-pizda(2,2)
8803 vv(2)=pizda(1,2)+pizda(2,1)
8804 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8805 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8807 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8809 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8812 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8814 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8821 c----------------------------------------------------------------------------
8822 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8823 implicit real*8 (a-h,o-z)
8824 include 'DIMENSIONS'
8825 include 'COMMON.IOUNITS'
8826 include 'COMMON.CHAIN'
8827 include 'COMMON.DERIV'
8828 include 'COMMON.INTERACT'
8829 include 'COMMON.CONTACTS'
8830 include 'COMMON.TORSION'
8831 include 'COMMON.VAR'
8832 include 'COMMON.GEO'
8833 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8835 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8837 C Parallel Antiparallel C
8843 C j|/k\| / |/k\|l / C
8848 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8850 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8851 C energy moment and not to the cluster cumulant.
8852 iti=itortyp(itype(i))
8853 if (j.lt.nres-1) then
8854 itj1=itortyp(itype(j+1))
8858 itk=itortyp(itype(k))
8859 itk1=itortyp(itype(k+1))
8860 if (l.lt.nres-1) then
8861 itl1=itortyp(itype(l+1))
8866 s1=dip(4,jj,i)*dip(4,kk,k)
8868 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8869 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8870 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8871 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8872 call transpose2(EE(1,1,itk),auxmat(1,1))
8873 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8874 vv(1)=pizda(1,1)+pizda(2,2)
8875 vv(2)=pizda(2,1)-pizda(1,2)
8876 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8877 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8878 cd & "sum",-(s2+s3+s4)
8880 eello6_graph3=-(s1+s2+s3+s4)
8882 eello6_graph3=-(s2+s3+s4)
8885 C Derivatives in gamma(k-1)
8886 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8887 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8888 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8889 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8890 C Derivatives in gamma(l-1)
8891 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8892 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8893 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8894 vv(1)=pizda(1,1)+pizda(2,2)
8895 vv(2)=pizda(2,1)-pizda(1,2)
8896 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8897 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8898 C Cartesian derivatives.
8904 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8906 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8909 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8911 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8912 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8914 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8915 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8917 vv(1)=pizda(1,1)+pizda(2,2)
8918 vv(2)=pizda(2,1)-pizda(1,2)
8919 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8921 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8923 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8926 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8928 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8930 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8936 c----------------------------------------------------------------------------
8937 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8938 implicit real*8 (a-h,o-z)
8939 include 'DIMENSIONS'
8940 include 'COMMON.IOUNITS'
8941 include 'COMMON.CHAIN'
8942 include 'COMMON.DERIV'
8943 include 'COMMON.INTERACT'
8944 include 'COMMON.CONTACTS'
8945 include 'COMMON.TORSION'
8946 include 'COMMON.VAR'
8947 include 'COMMON.GEO'
8948 include 'COMMON.FFIELD'
8949 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8950 & auxvec1(2),auxmat1(2,2)
8952 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8954 C Parallel Antiparallel C
8960 C \ j|/k\| \ |/k\|l C
8965 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8967 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8968 C energy moment and not to the cluster cumulant.
8969 cd write (2,*) 'eello_graph4: wturn6',wturn6
8970 iti=itortyp(itype(i))
8971 itj=itortyp(itype(j))
8972 if (j.lt.nres-1) then
8973 itj1=itortyp(itype(j+1))
8977 itk=itortyp(itype(k))
8978 if (k.lt.nres-1) then
8979 itk1=itortyp(itype(k+1))
8983 itl=itortyp(itype(l))
8984 if (l.lt.nres-1) then
8985 itl1=itortyp(itype(l+1))
8989 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8990 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8991 cd & ' itl',itl,' itl1',itl1
8994 s1=dip(3,jj,i)*dip(3,kk,k)
8996 s1=dip(2,jj,j)*dip(2,kk,l)
8999 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9000 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9002 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
9003 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9005 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
9006 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9008 call transpose2(EUg(1,1,k),auxmat(1,1))
9009 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9010 vv(1)=pizda(1,1)-pizda(2,2)
9011 vv(2)=pizda(2,1)+pizda(1,2)
9012 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9013 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9015 eello6_graph4=-(s1+s2+s3+s4)
9017 eello6_graph4=-(s2+s3+s4)
9019 C Derivatives in gamma(i-1)
9023 s1=dipderg(2,jj,i)*dip(3,kk,k)
9025 s1=dipderg(4,jj,j)*dip(2,kk,l)
9028 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9030 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
9031 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9033 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
9034 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9036 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9037 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9038 cd write (2,*) 'turn6 derivatives'
9040 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9042 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9046 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9048 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9052 C Derivatives in gamma(k-1)
9055 s1=dip(3,jj,i)*dipderg(2,kk,k)
9057 s1=dip(2,jj,j)*dipderg(4,kk,l)
9060 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9061 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9063 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
9064 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9066 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
9067 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9069 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9070 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9071 vv(1)=pizda(1,1)-pizda(2,2)
9072 vv(2)=pizda(2,1)+pizda(1,2)
9073 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9074 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9076 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9078 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9082 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9084 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9087 C Derivatives in gamma(j-1) or gamma(l-1)
9088 if (l.eq.j+1 .and. l.gt.1) then
9089 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9090 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9091 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9092 vv(1)=pizda(1,1)-pizda(2,2)
9093 vv(2)=pizda(2,1)+pizda(1,2)
9094 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9095 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9096 else if (j.gt.1) then
9097 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9098 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9099 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9100 vv(1)=pizda(1,1)-pizda(2,2)
9101 vv(2)=pizda(2,1)+pizda(1,2)
9102 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9103 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9104 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9106 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9109 C Cartesian derivatives.
9116 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9118 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9122 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9124 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9128 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9130 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9132 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9133 & b1(1,itj1),auxvec(1))
9134 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
9136 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9137 & b1(1,itl1),auxvec(1))
9138 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
9140 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9142 vv(1)=pizda(1,1)-pizda(2,2)
9143 vv(2)=pizda(2,1)+pizda(1,2)
9144 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9146 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9148 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9151 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9154 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9157 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9159 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9161 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9165 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9167 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9170 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9172 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9180 c----------------------------------------------------------------------------
9181 double precision function eello_turn6(i,jj,kk)
9182 implicit real*8 (a-h,o-z)
9183 include 'DIMENSIONS'
9184 include 'COMMON.IOUNITS'
9185 include 'COMMON.CHAIN'
9186 include 'COMMON.DERIV'
9187 include 'COMMON.INTERACT'
9188 include 'COMMON.CONTACTS'
9189 include 'COMMON.TORSION'
9190 include 'COMMON.VAR'
9191 include 'COMMON.GEO'
9192 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9193 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9195 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9196 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9197 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9198 C the respective energy moment and not to the cluster cumulant.
9207 iti=itortyp(itype(i))
9208 itk=itortyp(itype(k))
9209 itk1=itortyp(itype(k+1))
9210 itl=itortyp(itype(l))
9211 itj=itortyp(itype(j))
9212 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9213 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9214 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9219 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9221 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9225 derx_turn(lll,kkk,iii)=0.0d0
9232 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9234 cd write (2,*) 'eello6_5',eello6_5
9236 call transpose2(AEA(1,1,1),auxmat(1,1))
9237 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9238 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9239 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9241 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9242 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9243 s2 = scalar2(b1(1,itk),vtemp1(1))
9245 call transpose2(AEA(1,1,2),atemp(1,1))
9246 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9247 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9248 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9250 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9251 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9252 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9254 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9255 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9256 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9257 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9258 ss13 = scalar2(b1(1,itk),vtemp4(1))
9259 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9261 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9267 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9268 C Derivatives in gamma(i+2)
9272 call transpose2(AEA(1,1,1),auxmatd(1,1))
9273 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9274 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9275 call transpose2(AEAderg(1,1,2),atempd(1,1))
9276 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9277 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9279 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9280 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9281 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9287 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9288 C Derivatives in gamma(i+3)
9290 call transpose2(AEA(1,1,1),auxmatd(1,1))
9291 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9292 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9293 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9295 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9296 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9297 s2d = scalar2(b1(1,itk),vtemp1d(1))
9299 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9300 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9302 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9304 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9305 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9306 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9314 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9315 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9317 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9318 & -0.5d0*ekont*(s2d+s12d)
9320 C Derivatives in gamma(i+4)
9321 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9322 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9323 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9325 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9326 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9327 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9335 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9337 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9339 C Derivatives in gamma(i+5)
9341 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9342 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9343 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9345 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9346 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9347 s2d = scalar2(b1(1,itk),vtemp1d(1))
9349 call transpose2(AEA(1,1,2),atempd(1,1))
9350 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9351 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9353 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9354 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9356 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9357 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9358 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9366 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9367 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9369 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9370 & -0.5d0*ekont*(s2d+s12d)
9372 C Cartesian derivatives
9377 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9378 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9379 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9381 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9382 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9384 s2d = scalar2(b1(1,itk),vtemp1d(1))
9386 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9387 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9388 s8d = -(atempd(1,1)+atempd(2,2))*
9389 & scalar2(cc(1,1,itl),vtemp2(1))
9391 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9393 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9394 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9401 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9404 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9408 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9409 & - 0.5d0*(s8d+s12d)
9411 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9420 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9422 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9423 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9424 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9425 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9426 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9428 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9429 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9430 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9434 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9435 cd & 16*eel_turn6_num
9437 if (j.lt.nres-1) then
9444 if (l.lt.nres-1) then
9452 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9453 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9454 cgrad ghalf=0.5d0*ggg1(ll)
9456 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9457 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9458 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9459 & +ekont*derx_turn(ll,2,1)
9460 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9461 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9462 & +ekont*derx_turn(ll,4,1)
9463 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9464 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9465 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9466 cgrad ghalf=0.5d0*ggg2(ll)
9468 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9469 & +ekont*derx_turn(ll,2,2)
9470 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9471 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9472 & +ekont*derx_turn(ll,4,2)
9473 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9474 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9475 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9480 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9485 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9491 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9496 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9500 cd write (2,*) iii,g_corr6_loc(iii)
9502 eello_turn6=ekont*eel_turn6
9503 cd write (2,*) 'ekont',ekont
9504 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9508 C-----------------------------------------------------------------------------
9509 double precision function scalar(u,v)
9510 !DIR$ INLINEALWAYS scalar
9512 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9515 double precision u(3),v(3)
9516 cd double precision sc
9524 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9527 crc-------------------------------------------------
9528 SUBROUTINE MATVEC2(A1,V1,V2)
9529 !DIR$ INLINEALWAYS MATVEC2
9531 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9533 implicit real*8 (a-h,o-z)
9534 include 'DIMENSIONS'
9535 DIMENSION A1(2,2),V1(2),V2(2)
9539 c 3 VI=VI+A1(I,K)*V1(K)
9543 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9544 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9549 C---------------------------------------
9550 SUBROUTINE MATMAT2(A1,A2,A3)
9552 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9554 implicit real*8 (a-h,o-z)
9555 include 'DIMENSIONS'
9556 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9557 c DIMENSION AI3(2,2)
9561 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9567 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9568 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9569 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9570 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9578 c-------------------------------------------------------------------------
9579 double precision function scalar2(u,v)
9580 !DIR$ INLINEALWAYS scalar2
9582 double precision u(2),v(2)
9585 scalar2=u(1)*v(1)+u(2)*v(2)
9589 C-----------------------------------------------------------------------------
9591 subroutine transpose2(a,at)
9592 !DIR$ INLINEALWAYS transpose2
9594 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9597 double precision a(2,2),at(2,2)
9604 c--------------------------------------------------------------------------
9605 subroutine transpose(n,a,at)
9608 double precision a(n,n),at(n,n)
9616 C---------------------------------------------------------------------------
9617 subroutine prodmat3(a1,a2,kk,transp,prod)
9618 !DIR$ INLINEALWAYS prodmat3
9620 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9624 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9626 crc double precision auxmat(2,2),prod_(2,2)
9629 crc call transpose2(kk(1,1),auxmat(1,1))
9630 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9631 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9633 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9634 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9635 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9636 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9637 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9638 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9639 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9640 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9643 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9644 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9646 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9647 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9648 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9649 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9650 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9651 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9652 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9653 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9656 c call transpose2(a2(1,1),a2t(1,1))
9659 crc print *,((prod_(i,j),i=1,2),j=1,2)
9660 crc print *,((prod(i,j),i=1,2),j=1,2)