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
103 goto (101,102,103,104,105,106) ipot
104 C Lennard-Jones potential.
106 cd print '(a)','Exit ELJ'
108 C Lennard-Jones-Kihara potential (shifted).
111 C Berne-Pechukas potential (dilated LJ, angular dependence).
114 C Gay-Berne potential (shifted LJ, angular dependence).
116 C print *,"bylem w egb"
118 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
121 C Soft-sphere potential
122 106 call e_softsphere(evdw)
124 C Calculate electrostatic (H-bonding) energy of the main chain.
128 cmc Sep-06: egb takes care of dynamic ss bonds too
130 c if (dyn_ss) call dyn_set_nss
132 c print *,"Processor",myrank," computed USCSC"
138 time_vec=time_vec+MPI_Wtime()-time01
140 c print *,"Processor",myrank," left VEC_AND_DERIV"
143 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
144 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
145 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
146 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
148 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
149 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
150 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
151 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
153 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
162 write (iout,*) "Soft-spheer ELEC potential"
163 c call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
166 c print *,"Processor",myrank," computed UELEC"
168 C Calculate excluded-volume interaction energy between peptide groups
173 call escp(evdw2,evdw2_14)
179 c write (iout,*) "Soft-sphere SCP potential"
180 call escp_soft_sphere(evdw2,evdw2_14)
183 c Calculate the bond-stretching energy
187 C Calculate the disulfide-bridge and other energy and the contributions
188 C from other distance constraints.
189 cd print *,'Calling EHPB'
191 cd print *,'EHPB exitted succesfully.'
193 C Calculate the virtual-bond-angle energy.
195 if (wang.gt.0d0) then
200 c print *,"Processor",myrank," computed UB"
202 C Calculate the SC local energy.
204 C print *,"TU DOCHODZE?"
206 c print *,"Processor",myrank," computed USC"
208 C Calculate the virtual-bond torsional energy.
210 cd print *,'nterm=',nterm
212 call etor(etors,edihcnstr)
217 c print *,"Processor",myrank," computed Utor"
219 C 6/23/01 Calculate double-torsional energy
221 if (wtor_d.gt.0) then
226 c print *,"Processor",myrank," computed Utord"
228 C 21/5/07 Calculate local sicdechain correlation energy
230 if (wsccor.gt.0.0d0) then
231 call eback_sc_corr(esccor)
235 C print *,"PRZED MULIt"
236 c print *,"Processor",myrank," computed Usccorr"
238 C 12/1/95 Multi-body terms
242 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
243 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
244 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
245 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
246 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
253 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
254 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
255 cd write (iout,*) "multibody_hb ecorr",ecorr
257 c print *,"Processor",myrank," computed Ucorr"
259 C If performing constraint dynamics, call the constraint energy
260 C after the equilibration time
261 if(usampl.and.totT.gt.eq_time) then
268 C 01/27/2015 added by adasko
269 C the energy component below is energy transfer into lipid environment
270 C based on partition function
271 C print *,"przed lipidami"
272 if (wliptran.gt.0) then
273 call Eliptransfer(eliptran)
275 C print *,"za lipidami"
276 if (AFMlog.gt.0) then
277 call AFMforce(Eafmforce)
278 else if (selfguide.gt.0) then
279 call AFMvel(Eafmforce)
282 time_enecalc=time_enecalc+MPI_Wtime()-time00
284 c print *,"Processor",myrank," computed Uconstr"
293 energia(2)=evdw2-evdw2_14
310 energia(8)=eello_turn3
311 energia(9)=eello_turn4
318 energia(19)=edihcnstr
320 energia(20)=Uconst+Uconst_back
323 energia(23)=Eafmforce
324 c Here are the energies showed per procesor if the are more processors
325 c per molecule then we sum it up in sum_energy subroutine
326 c print *," Processor",myrank," calls SUM_ENERGY"
327 call sum_energy(energia,.true.)
328 if (dyn_ss) call dyn_set_nss
329 c print *," Processor",myrank," left SUM_ENERGY"
331 time_sumene=time_sumene+MPI_Wtime()-time00
335 c-------------------------------------------------------------------------------
336 subroutine sum_energy(energia,reduce)
337 implicit real*8 (a-h,o-z)
342 cMS$ATTRIBUTES C :: proc_proc
348 include 'COMMON.SETUP'
349 include 'COMMON.IOUNITS'
350 double precision energia(0:n_ene),enebuff(0:n_ene+1)
351 include 'COMMON.FFIELD'
352 include 'COMMON.DERIV'
353 include 'COMMON.INTERACT'
354 include 'COMMON.SBRIDGE'
355 include 'COMMON.CHAIN'
357 include 'COMMON.CONTROL'
358 include 'COMMON.TIME1'
361 if (nfgtasks.gt.1 .and. reduce) then
363 write (iout,*) "energies before REDUCE"
364 call enerprint(energia)
368 enebuff(i)=energia(i)
371 call MPI_Barrier(FG_COMM,IERR)
372 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
374 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
375 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
377 write (iout,*) "energies after REDUCE"
378 call enerprint(energia)
381 time_Reduce=time_Reduce+MPI_Wtime()-time00
383 if (fg_rank.eq.0) then
387 evdw2=energia(2)+energia(18)
403 eello_turn3=energia(8)
404 eello_turn4=energia(9)
411 edihcnstr=energia(19)
416 Eafmforce=energia(23)
418 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
419 & +wang*ebe+wtor*etors+wscloc*escloc
420 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
421 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
422 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
423 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+Eafmforce
425 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
426 & +wang*ebe+wtor*etors+wscloc*escloc
427 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
428 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
429 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
430 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran
437 if (isnan(etot).ne.0) energia(0)=1.0d+99
439 if (isnan(etot)) energia(0)=1.0d+99
444 idumm=proc_proc(etot,i)
446 call proc_proc(etot,i)
448 if(i.eq.1)energia(0)=1.0d+99
455 c-------------------------------------------------------------------------------
456 subroutine sum_gradient
457 implicit real*8 (a-h,o-z)
462 cMS$ATTRIBUTES C :: proc_proc
468 double precision gradbufc(3,-1:maxres),gradbufx(3,-1:maxres),
469 & glocbuf(4*maxres),gradbufc_sum(3,-1:maxres)
470 & ,gloc_scbuf(3,-1:maxres)
471 include 'COMMON.SETUP'
472 include 'COMMON.IOUNITS'
473 include 'COMMON.FFIELD'
474 include 'COMMON.DERIV'
475 include 'COMMON.INTERACT'
476 include 'COMMON.SBRIDGE'
477 include 'COMMON.CHAIN'
479 include 'COMMON.CONTROL'
480 include 'COMMON.TIME1'
481 include 'COMMON.MAXGRAD'
482 include 'COMMON.SCCOR'
487 write (iout,*) "sum_gradient gvdwc, gvdwx"
489 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
490 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
495 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
496 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
497 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
500 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
501 C in virtual-bond-vector coordinates
504 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
506 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
507 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
509 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
511 c write (iout,'(i5,3f10.5,2x,f10.5)')
512 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
514 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
516 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
517 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
525 gradbufc(j,i)=wsc*gvdwc(j,i)+
526 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
527 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
528 & wel_loc*gel_loc_long(j,i)+
529 & wcorr*gradcorr_long(j,i)+
530 & wcorr5*gradcorr5_long(j,i)+
531 & wcorr6*gradcorr6_long(j,i)+
532 & wturn6*gcorr6_turn_long(j,i)+
534 & +wliptran*gliptranc(j,i)
542 gradbufc(j,i)=wsc*gvdwc(j,i)+
543 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
544 & welec*gelc_long(j,i)+
546 & wel_loc*gel_loc_long(j,i)+
547 & wcorr*gradcorr_long(j,i)+
548 & wcorr5*gradcorr5_long(j,i)+
549 & wcorr6*gradcorr6_long(j,i)+
550 & wturn6*gcorr6_turn_long(j,i)+
552 & +wliptran*gliptranc(j,i)
559 if (nfgtasks.gt.1) then
562 write (iout,*) "gradbufc before allreduce"
564 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
570 gradbufc_sum(j,i)=gradbufc(j,i)
573 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
574 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
575 c time_reduce=time_reduce+MPI_Wtime()-time00
577 c write (iout,*) "gradbufc_sum after allreduce"
579 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
584 c time_allreduce=time_allreduce+MPI_Wtime()-time00
592 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
593 write (iout,*) (i," jgrad_start",jgrad_start(i),
594 & " jgrad_end ",jgrad_end(i),
595 & i=igrad_start,igrad_end)
598 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
599 c do not parallelize this part.
601 c do i=igrad_start,igrad_end
602 c do j=jgrad_start(i),jgrad_end(i)
604 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
609 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
613 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
617 write (iout,*) "gradbufc after summing"
619 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
626 write (iout,*) "gradbufc"
628 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
634 gradbufc_sum(j,i)=gradbufc(j,i)
639 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
643 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
648 c gradbufc(k,i)=0.0d0
652 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
657 write (iout,*) "gradbufc after summing"
659 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
667 gradbufc(k,nres)=0.0d0
672 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
673 & wel_loc*gel_loc(j,i)+
674 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
675 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
676 & wel_loc*gel_loc_long(j,i)+
677 & wcorr*gradcorr_long(j,i)+
678 & wcorr5*gradcorr5_long(j,i)+
679 & wcorr6*gradcorr6_long(j,i)+
680 & wturn6*gcorr6_turn_long(j,i))+
682 & wcorr*gradcorr(j,i)+
683 & wturn3*gcorr3_turn(j,i)+
684 & wturn4*gcorr4_turn(j,i)+
685 & wcorr5*gradcorr5(j,i)+
686 & wcorr6*gradcorr6(j,i)+
687 & wturn6*gcorr6_turn(j,i)+
688 & wsccor*gsccorc(j,i)
689 & +wscloc*gscloc(j,i)
690 & +wliptran*gliptranc(j,i)
693 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
694 & wel_loc*gel_loc(j,i)+
695 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
696 & welec*gelc_long(j,i)
697 & wel_loc*gel_loc_long(j,i)+
698 & wcorr*gcorr_long(j,i)+
699 & wcorr5*gradcorr5_long(j,i)+
700 & wcorr6*gradcorr6_long(j,i)+
701 & wturn6*gcorr6_turn_long(j,i))+
703 & wcorr*gradcorr(j,i)+
704 & wturn3*gcorr3_turn(j,i)+
705 & wturn4*gcorr4_turn(j,i)+
706 & wcorr5*gradcorr5(j,i)+
707 & wcorr6*gradcorr6(j,i)+
708 & wturn6*gcorr6_turn(j,i)+
709 & wsccor*gsccorc(j,i)
710 & +wscloc*gscloc(j,i)
711 & +wliptran*gliptranc(j,i)
715 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
717 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
718 & wsccor*gsccorx(j,i)
719 & +wscloc*gsclocx(j,i)
720 & +wliptran*gliptranx(j,i)
724 write (iout,*) "gloc before adding corr"
726 write (iout,*) i,gloc(i,icg)
730 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
731 & +wcorr5*g_corr5_loc(i)
732 & +wcorr6*g_corr6_loc(i)
733 & +wturn4*gel_loc_turn4(i)
734 & +wturn3*gel_loc_turn3(i)
735 & +wturn6*gel_loc_turn6(i)
736 & +wel_loc*gel_loc_loc(i)
739 write (iout,*) "gloc after adding corr"
741 write (iout,*) i,gloc(i,icg)
745 if (nfgtasks.gt.1) then
748 gradbufc(j,i)=gradc(j,i,icg)
749 gradbufx(j,i)=gradx(j,i,icg)
753 glocbuf(i)=gloc(i,icg)
757 write (iout,*) "gloc_sc before reduce"
760 write (iout,*) i,j,gloc_sc(j,i,icg)
767 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
771 call MPI_Barrier(FG_COMM,IERR)
772 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
774 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
775 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
776 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
777 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
778 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
779 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
780 time_reduce=time_reduce+MPI_Wtime()-time00
781 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
782 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
783 time_reduce=time_reduce+MPI_Wtime()-time00
786 write (iout,*) "gloc_sc after reduce"
789 write (iout,*) i,j,gloc_sc(j,i,icg)
795 write (iout,*) "gloc after reduce"
797 write (iout,*) i,gloc(i,icg)
802 if (gnorm_check) then
804 c Compute the maximum elements of the gradient
814 gcorr3_turn_max=0.0d0
815 gcorr4_turn_max=0.0d0
818 gcorr6_turn_max=0.0d0
828 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
829 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
830 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
831 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
832 & gvdwc_scp_max=gvdwc_scp_norm
833 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
834 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
835 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
836 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
837 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
838 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
839 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
840 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
841 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
842 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
843 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
844 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
845 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
847 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
848 & gcorr3_turn_max=gcorr3_turn_norm
849 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
851 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
852 & gcorr4_turn_max=gcorr4_turn_norm
853 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
854 if (gradcorr5_norm.gt.gradcorr5_max)
855 & gradcorr5_max=gradcorr5_norm
856 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
857 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
858 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
860 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
861 & gcorr6_turn_max=gcorr6_turn_norm
862 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
863 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
864 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
865 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
866 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
867 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
868 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
869 if (gradx_scp_norm.gt.gradx_scp_max)
870 & gradx_scp_max=gradx_scp_norm
871 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
872 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
873 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
874 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
875 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
876 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
877 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
878 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
882 open(istat,file=statname,position="append")
884 open(istat,file=statname,access="append")
886 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
887 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
888 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
889 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
890 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
891 & gsccorx_max,gsclocx_max
893 if (gvdwc_max.gt.1.0d4) then
894 write (iout,*) "gvdwc gvdwx gradb gradbx"
896 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
897 & gradb(j,i),gradbx(j,i),j=1,3)
899 call pdbout(0.0d0,'cipiszcze',iout)
905 write (iout,*) "gradc gradx gloc"
907 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
908 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
912 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
916 c-------------------------------------------------------------------------------
917 subroutine rescale_weights(t_bath)
918 implicit real*8 (a-h,o-z)
920 include 'COMMON.IOUNITS'
921 include 'COMMON.FFIELD'
922 include 'COMMON.SBRIDGE'
923 double precision kfac /2.4d0/
924 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
926 c facT=2*temp0/(t_bath+temp0)
927 if (rescale_mode.eq.0) then
933 else if (rescale_mode.eq.1) then
934 facT=kfac/(kfac-1.0d0+t_bath/temp0)
935 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
936 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
937 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
938 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
939 else if (rescale_mode.eq.2) then
945 facT=licznik/dlog(dexp(x)+dexp(-x))
946 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
947 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
948 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
949 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
951 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
952 write (*,*) "Wrong RESCALE_MODE",rescale_mode
954 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
958 welec=weights(3)*fact
959 wcorr=weights(4)*fact3
960 wcorr5=weights(5)*fact4
961 wcorr6=weights(6)*fact5
962 wel_loc=weights(7)*fact2
963 wturn3=weights(8)*fact2
964 wturn4=weights(9)*fact3
965 wturn6=weights(10)*fact5
966 wtor=weights(13)*fact
967 wtor_d=weights(14)*fact2
968 wsccor=weights(21)*fact
972 C------------------------------------------------------------------------
973 subroutine enerprint(energia)
974 implicit real*8 (a-h,o-z)
976 include 'COMMON.IOUNITS'
977 include 'COMMON.FFIELD'
978 include 'COMMON.SBRIDGE'
980 double precision energia(0:n_ene)
985 evdw2=energia(2)+energia(18)
997 eello_turn3=energia(8)
998 eello_turn4=energia(9)
999 eello_turn6=energia(10)
1005 edihcnstr=energia(19)
1009 eliptran=energia(22)
1010 Eafmforce=energia(23)
1012 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1013 & estr,wbond,ebe,wang,
1014 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1016 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1017 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1018 & edihcnstr,ebr*nss,
1019 & Uconst,eliptran,wliptran,Eafmforce,etot
1020 10 format (/'Virtual-chain energies:'//
1021 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1022 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1023 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1024 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1025 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1026 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1027 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1028 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1029 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1030 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1031 & ' (SS bridges & dist. cnstr.)'/
1032 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1033 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1034 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1035 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1036 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1037 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1038 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1039 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1040 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1041 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1042 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1043 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1044 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1045 & 'ETOT= ',1pE16.6,' (total)')
1048 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1049 & estr,wbond,ebe,wang,
1050 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1052 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1053 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1054 & ebr*nss,Uconst,eliptran,wliptran,Eafmforc,etot
1055 10 format (/'Virtual-chain energies:'//
1056 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1057 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1058 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1059 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1060 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1061 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1062 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1063 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1064 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1065 & ' (SS bridges & dist. cnstr.)'/
1066 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1067 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1068 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1069 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1070 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1071 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1072 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1073 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1074 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1075 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1076 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1077 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1078 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1079 & 'ETOT= ',1pE16.6,' (total)')
1083 C-----------------------------------------------------------------------
1084 subroutine elj(evdw)
1086 C This subroutine calculates the interaction energy of nonbonded side chains
1087 C assuming the LJ potential of interaction.
1089 implicit real*8 (a-h,o-z)
1090 include 'DIMENSIONS'
1091 parameter (accur=1.0d-10)
1092 include 'COMMON.GEO'
1093 include 'COMMON.VAR'
1094 include 'COMMON.LOCAL'
1095 include 'COMMON.CHAIN'
1096 include 'COMMON.DERIV'
1097 include 'COMMON.INTERACT'
1098 include 'COMMON.TORSION'
1099 include 'COMMON.SBRIDGE'
1100 include 'COMMON.NAMES'
1101 include 'COMMON.IOUNITS'
1102 include 'COMMON.CONTACTS'
1104 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1106 do i=iatsc_s,iatsc_e
1107 itypi=iabs(itype(i))
1108 if (itypi.eq.ntyp1) cycle
1109 itypi1=iabs(itype(i+1))
1116 C Calculate SC interaction energy.
1118 do iint=1,nint_gr(i)
1119 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1120 cd & 'iend=',iend(i,iint)
1121 do j=istart(i,iint),iend(i,iint)
1122 itypj=iabs(itype(j))
1123 if (itypj.eq.ntyp1) cycle
1127 C Change 12/1/95 to calculate four-body interactions
1128 rij=xj*xj+yj*yj+zj*zj
1130 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1131 eps0ij=eps(itypi,itypj)
1133 C have you changed here?
1137 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1138 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1139 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1140 cd & restyp(itypi),i,restyp(itypj),j,a(itypi,itypj),
1141 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1142 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1145 C Calculate the components of the gradient in DC and X
1147 fac=-rrij*(e1+evdwij)
1152 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1153 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1154 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1155 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1159 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1163 C 12/1/95, revised on 5/20/97
1165 C Calculate the contact function. The ith column of the array JCONT will
1166 C contain the numbers of atoms that make contacts with the atom I (of numbers
1167 C greater than I). The arrays FACONT and GACONT will contain the values of
1168 C the contact function and its derivative.
1170 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1171 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1172 C Uncomment next line, if the correlation interactions are contact function only
1173 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1175 sigij=sigma(itypi,itypj)
1176 r0ij=rs0(itypi,itypj)
1178 C Check whether the SC's are not too far to make a contact.
1181 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1182 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1184 if (fcont.gt.0.0D0) then
1185 C If the SC-SC distance if close to sigma, apply spline.
1186 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1187 cAdam & fcont1,fprimcont1)
1188 cAdam fcont1=1.0d0-fcont1
1189 cAdam if (fcont1.gt.0.0d0) then
1190 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1191 cAdam fcont=fcont*fcont1
1193 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1194 cga eps0ij=1.0d0/dsqrt(eps0ij)
1196 cga gg(k)=gg(k)*eps0ij
1198 cga eps0ij=-evdwij*eps0ij
1199 C Uncomment for AL's type of SC correlation interactions.
1200 cadam eps0ij=-evdwij
1201 num_conti=num_conti+1
1202 jcont(num_conti,i)=j
1203 facont(num_conti,i)=fcont*eps0ij
1204 fprimcont=eps0ij*fprimcont/rij
1206 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1207 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1208 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1209 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1210 gacont(1,num_conti,i)=-fprimcont*xj
1211 gacont(2,num_conti,i)=-fprimcont*yj
1212 gacont(3,num_conti,i)=-fprimcont*zj
1213 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1214 cd write (iout,'(2i3,3f10.5)')
1215 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1221 num_cont(i)=num_conti
1225 gvdwc(j,i)=expon*gvdwc(j,i)
1226 gvdwx(j,i)=expon*gvdwx(j,i)
1229 C******************************************************************************
1233 C To save time, the factor of EXPON has been extracted from ALL components
1234 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1237 C******************************************************************************
1240 C-----------------------------------------------------------------------------
1241 subroutine eljk(evdw)
1243 C This subroutine calculates the interaction energy of nonbonded side chains
1244 C assuming the LJK potential of interaction.
1246 implicit real*8 (a-h,o-z)
1247 include 'DIMENSIONS'
1248 include 'COMMON.GEO'
1249 include 'COMMON.VAR'
1250 include 'COMMON.LOCAL'
1251 include 'COMMON.CHAIN'
1252 include 'COMMON.DERIV'
1253 include 'COMMON.INTERACT'
1254 include 'COMMON.IOUNITS'
1255 include 'COMMON.NAMES'
1258 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1260 do i=iatsc_s,iatsc_e
1261 itypi=iabs(itype(i))
1262 if (itypi.eq.ntyp1) cycle
1263 itypi1=iabs(itype(i+1))
1268 C Calculate SC interaction energy.
1270 do iint=1,nint_gr(i)
1271 do j=istart(i,iint),iend(i,iint)
1272 itypj=iabs(itype(j))
1273 if (itypj.eq.ntyp1) cycle
1277 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1278 fac_augm=rrij**expon
1279 e_augm=augm(itypi,itypj)*fac_augm
1280 r_inv_ij=dsqrt(rrij)
1282 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1283 fac=r_shift_inv**expon
1284 C have you changed here?
1288 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1289 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1290 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1291 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1292 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1293 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1294 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1297 C Calculate the components of the gradient in DC and X
1299 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1304 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1305 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1306 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1307 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1311 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1319 gvdwc(j,i)=expon*gvdwc(j,i)
1320 gvdwx(j,i)=expon*gvdwx(j,i)
1325 C-----------------------------------------------------------------------------
1326 subroutine ebp(evdw)
1328 C This subroutine calculates the interaction energy of nonbonded side chains
1329 C assuming the Berne-Pechukas potential of interaction.
1331 implicit real*8 (a-h,o-z)
1332 include 'DIMENSIONS'
1333 include 'COMMON.GEO'
1334 include 'COMMON.VAR'
1335 include 'COMMON.LOCAL'
1336 include 'COMMON.CHAIN'
1337 include 'COMMON.DERIV'
1338 include 'COMMON.NAMES'
1339 include 'COMMON.INTERACT'
1340 include 'COMMON.IOUNITS'
1341 include 'COMMON.CALC'
1342 common /srutu/ icall
1343 c double precision rrsave(maxdim)
1346 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1348 c if (icall.eq.0) then
1354 do i=iatsc_s,iatsc_e
1355 itypi=iabs(itype(i))
1356 if (itypi.eq.ntyp1) cycle
1357 itypi1=iabs(itype(i+1))
1361 dxi=dc_norm(1,nres+i)
1362 dyi=dc_norm(2,nres+i)
1363 dzi=dc_norm(3,nres+i)
1364 c dsci_inv=dsc_inv(itypi)
1365 dsci_inv=vbld_inv(i+nres)
1367 C Calculate SC interaction energy.
1369 do iint=1,nint_gr(i)
1370 do j=istart(i,iint),iend(i,iint)
1372 itypj=iabs(itype(j))
1373 if (itypj.eq.ntyp1) cycle
1374 c dscj_inv=dsc_inv(itypj)
1375 dscj_inv=vbld_inv(j+nres)
1376 chi1=chi(itypi,itypj)
1377 chi2=chi(itypj,itypi)
1384 alf12=0.5D0*(alf1+alf2)
1385 C For diagnostics only!!!
1398 dxj=dc_norm(1,nres+j)
1399 dyj=dc_norm(2,nres+j)
1400 dzj=dc_norm(3,nres+j)
1401 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1402 cd if (icall.eq.0) then
1408 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1410 C Calculate whole angle-dependent part of epsilon and contributions
1411 C to its derivatives
1412 C have you changed here?
1413 fac=(rrij*sigsq)**expon2
1416 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1417 eps2der=evdwij*eps3rt
1418 eps3der=evdwij*eps2rt
1419 evdwij=evdwij*eps2rt*eps3rt
1422 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1424 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1425 cd & restyp(itypi),i,restyp(itypj),j,
1426 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1427 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1428 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1431 C Calculate gradient components.
1432 e1=e1*eps1*eps2rt**2*eps3rt**2
1433 fac=-expon*(e1+evdwij)
1436 C Calculate radial part of the gradient
1440 C Calculate the angular part of the gradient and sum add the contributions
1441 C to the appropriate components of the Cartesian gradient.
1449 C-----------------------------------------------------------------------------
1450 subroutine egb(evdw)
1452 C This subroutine calculates the interaction energy of nonbonded side chains
1453 C assuming the Gay-Berne potential of interaction.
1455 implicit real*8 (a-h,o-z)
1456 include 'DIMENSIONS'
1457 include 'COMMON.GEO'
1458 include 'COMMON.VAR'
1459 include 'COMMON.LOCAL'
1460 include 'COMMON.CHAIN'
1461 include 'COMMON.DERIV'
1462 include 'COMMON.NAMES'
1463 include 'COMMON.INTERACT'
1464 include 'COMMON.IOUNITS'
1465 include 'COMMON.CALC'
1466 include 'COMMON.CONTROL'
1467 include 'COMMON.SPLITELE'
1468 include 'COMMON.SBRIDGE'
1470 integer xshift,yshift,zshift
1472 ccccc energy_dec=.false.
1473 C print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1476 c if (icall.eq.0) lprn=.false.
1478 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1479 C we have the original box)
1483 do i=iatsc_s,iatsc_e
1484 itypi=iabs(itype(i))
1485 if (itypi.eq.ntyp1) cycle
1486 itypi1=iabs(itype(i+1))
1490 C Return atom into box, boxxsize is size of box in x dimension
1492 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1493 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1494 C Condition for being inside the proper box
1495 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1496 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1500 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1501 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1502 C Condition for being inside the proper box
1503 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1504 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1508 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1509 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1510 C Condition for being inside the proper box
1511 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1512 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1516 if (xi.lt.0) xi=xi+boxxsize
1518 if (yi.lt.0) yi=yi+boxysize
1520 if (zi.lt.0) zi=zi+boxzsize
1521 C define scaling factor for lipids
1523 C if (positi.le.0) positi=positi+boxzsize
1525 C first for peptide groups
1526 c for each residue check if it is in lipid or lipid water border area
1527 if ((zi.gt.bordlipbot)
1528 &.and.(zi.lt.bordliptop)) then
1529 C the energy transfer exist
1530 if (zi.lt.buflipbot) then
1531 C what fraction I am in
1533 & ((zi-bordlipbot)/lipbufthick)
1534 C lipbufthick is thickenes of lipid buffore
1535 sslipi=sscalelip(fracinbuf)
1536 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1537 elseif (zi.gt.bufliptop) then
1538 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1539 sslipi=sscalelip(fracinbuf)
1540 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1550 C xi=xi+xshift*boxxsize
1551 C yi=yi+yshift*boxysize
1552 C zi=zi+zshift*boxzsize
1554 dxi=dc_norm(1,nres+i)
1555 dyi=dc_norm(2,nres+i)
1556 dzi=dc_norm(3,nres+i)
1557 c dsci_inv=dsc_inv(itypi)
1558 dsci_inv=vbld_inv(i+nres)
1559 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1560 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1562 C Calculate SC interaction energy.
1564 do iint=1,nint_gr(i)
1565 do j=istart(i,iint),iend(i,iint)
1566 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1567 call dyn_ssbond_ene(i,j,evdwij)
1569 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1570 & 'evdw',i,j,evdwij,' ss'
1573 itypj=iabs(itype(j))
1574 if (itypj.eq.ntyp1) cycle
1575 c dscj_inv=dsc_inv(itypj)
1576 dscj_inv=vbld_inv(j+nres)
1577 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1578 c & 1.0d0/vbld(j+nres)
1579 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1580 sig0ij=sigma(itypi,itypj)
1581 chi1=chi(itypi,itypj)
1582 chi2=chi(itypj,itypi)
1589 alf12=0.5D0*(alf1+alf2)
1590 C For diagnostics only!!!
1603 C Return atom J into box the original box
1605 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1606 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1607 C Condition for being inside the proper box
1608 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1609 c & (xj.lt.((-0.5d0)*boxxsize))) then
1613 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1614 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1615 C Condition for being inside the proper box
1616 c if ((yj.gt.((0.5d0)*boxysize)).or.
1617 c & (yj.lt.((-0.5d0)*boxysize))) then
1621 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1622 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1623 C Condition for being inside the proper box
1624 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1625 c & (zj.lt.((-0.5d0)*boxzsize))) then
1629 if (xj.lt.0) xj=xj+boxxsize
1631 if (yj.lt.0) yj=yj+boxysize
1633 if (zj.lt.0) zj=zj+boxzsize
1634 if ((zj.gt.bordlipbot)
1635 &.and.(zj.lt.bordliptop)) then
1636 C the energy transfer exist
1637 if (zj.lt.buflipbot) then
1638 C what fraction I am in
1640 & ((zj-bordlipbot)/lipbufthick)
1641 C lipbufthick is thickenes of lipid buffore
1642 sslipj=sscalelip(fracinbuf)
1643 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1644 elseif (zj.gt.bufliptop) then
1645 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1646 sslipj=sscalelip(fracinbuf)
1647 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1656 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1657 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1658 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1659 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1660 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'(2e10.5)')
1661 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1662 C if (ssgradlipj.gt.0.0d0) print *,"??WTF??"
1663 C print *,sslipi,sslipj,bordlipbot,zi,zj
1664 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1672 xj=xj_safe+xshift*boxxsize
1673 yj=yj_safe+yshift*boxysize
1674 zj=zj_safe+zshift*boxzsize
1675 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1676 if(dist_temp.lt.dist_init) then
1686 if (subchap.eq.1) then
1695 dxj=dc_norm(1,nres+j)
1696 dyj=dc_norm(2,nres+j)
1697 dzj=dc_norm(3,nres+j)
1701 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1702 c write (iout,*) "j",j," dc_norm",
1703 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1704 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1706 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1707 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1709 c write (iout,'(a7,4f8.3)')
1710 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1711 if (sss.gt.0.0d0) then
1712 C Calculate angle-dependent terms of energy and contributions to their
1716 sig=sig0ij*dsqrt(sigsq)
1717 rij_shift=1.0D0/rij-sig+sig0ij
1718 c for diagnostics; uncomment
1719 c rij_shift=1.2*sig0ij
1720 C I hate to put IF's in the loops, but here don't have another choice!!!!
1721 if (rij_shift.le.0.0D0) then
1723 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1724 cd & restyp(itypi),i,restyp(itypj),j,
1725 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1729 c---------------------------------------------------------------
1730 rij_shift=1.0D0/rij_shift
1731 fac=rij_shift**expon
1732 C here to start with
1737 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1738 eps2der=evdwij*eps3rt
1739 eps3der=evdwij*eps2rt
1740 C write(63,'(2i3,2e10.3,2f10.5)') i,j,aa,bb, evdwij,
1741 C &((sslipi+sslipj)/2.0d0+
1742 C &(2.0d0-sslipi-sslipj)/2.0d0)
1743 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1744 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1745 evdwij=evdwij*eps2rt*eps3rt
1746 evdw=evdw+evdwij*sss
1748 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1750 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1751 & restyp(itypi),i,restyp(itypj),j,
1752 & epsi,sigm,chi1,chi2,chip1,chip2,
1753 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1754 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1758 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1761 C Calculate gradient components.
1762 e1=e1*eps1*eps2rt**2*eps3rt**2
1763 fac=-expon*(e1+evdwij)*rij_shift
1766 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1767 c & evdwij,fac,sigma(itypi,itypj),expon
1768 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1770 C Calculate the radial part of the gradient
1771 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1772 &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1773 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1774 &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1775 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1776 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1782 C Calculate angular part of the gradient.
1792 c write (iout,*) "Number of loop steps in EGB:",ind
1793 cccc energy_dec=.false.
1796 C-----------------------------------------------------------------------------
1797 subroutine egbv(evdw)
1799 C This subroutine calculates the interaction energy of nonbonded side chains
1800 C assuming the Gay-Berne-Vorobjev potential of interaction.
1802 implicit real*8 (a-h,o-z)
1803 include 'DIMENSIONS'
1804 include 'COMMON.GEO'
1805 include 'COMMON.VAR'
1806 include 'COMMON.LOCAL'
1807 include 'COMMON.CHAIN'
1808 include 'COMMON.DERIV'
1809 include 'COMMON.NAMES'
1810 include 'COMMON.INTERACT'
1811 include 'COMMON.IOUNITS'
1812 include 'COMMON.CALC'
1813 common /srutu/ icall
1816 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1819 c if (icall.eq.0) lprn=.true.
1821 do i=iatsc_s,iatsc_e
1822 itypi=iabs(itype(i))
1823 if (itypi.eq.ntyp1) cycle
1824 itypi1=iabs(itype(i+1))
1829 if (xi.lt.0) xi=xi+boxxsize
1831 if (yi.lt.0) yi=yi+boxysize
1833 if (zi.lt.0) zi=zi+boxzsize
1834 C define scaling factor for lipids
1836 C if (positi.le.0) positi=positi+boxzsize
1838 C first for peptide groups
1839 c for each residue check if it is in lipid or lipid water border area
1840 if ((zi.gt.bordlipbot)
1841 &.and.(zi.lt.bordliptop)) then
1842 C the energy transfer exist
1843 if (zi.lt.buflipbot) then
1844 C what fraction I am in
1846 & ((zi-bordlipbot)/lipbufthick)
1847 C lipbufthick is thickenes of lipid buffore
1848 sslipi=sscalelip(fracinbuf)
1849 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1850 elseif (zi.gt.bufliptop) then
1851 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1852 sslipi=sscalelip(fracinbuf)
1853 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1863 dxi=dc_norm(1,nres+i)
1864 dyi=dc_norm(2,nres+i)
1865 dzi=dc_norm(3,nres+i)
1866 c dsci_inv=dsc_inv(itypi)
1867 dsci_inv=vbld_inv(i+nres)
1869 C Calculate SC interaction energy.
1871 do iint=1,nint_gr(i)
1872 do j=istart(i,iint),iend(i,iint)
1874 itypj=iabs(itype(j))
1875 if (itypj.eq.ntyp1) cycle
1876 c dscj_inv=dsc_inv(itypj)
1877 dscj_inv=vbld_inv(j+nres)
1878 sig0ij=sigma(itypi,itypj)
1879 r0ij=r0(itypi,itypj)
1880 chi1=chi(itypi,itypj)
1881 chi2=chi(itypj,itypi)
1888 alf12=0.5D0*(alf1+alf2)
1889 C For diagnostics only!!!
1903 if (xj.lt.0) xj=xj+boxxsize
1905 if (yj.lt.0) yj=yj+boxysize
1907 if (zj.lt.0) zj=zj+boxzsize
1908 if ((zj.gt.bordlipbot)
1909 &.and.(zj.lt.bordliptop)) then
1910 C the energy transfer exist
1911 if (zj.lt.buflipbot) then
1912 C what fraction I am in
1914 & ((zj-bordlipbot)/lipbufthick)
1915 C lipbufthick is thickenes of lipid buffore
1916 sslipj=sscalelip(fracinbuf)
1917 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1918 elseif (zj.gt.bufliptop) then
1919 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1920 sslipj=sscalelip(fracinbuf)
1921 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1930 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1931 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1932 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1933 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1934 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5')
1935 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1936 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1944 xj=xj_safe+xshift*boxxsize
1945 yj=yj_safe+yshift*boxysize
1946 zj=zj_safe+zshift*boxzsize
1947 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1948 if(dist_temp.lt.dist_init) then
1958 if (subchap.eq.1) then
1967 dxj=dc_norm(1,nres+j)
1968 dyj=dc_norm(2,nres+j)
1969 dzj=dc_norm(3,nres+j)
1970 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1972 C Calculate angle-dependent terms of energy and contributions to their
1976 sig=sig0ij*dsqrt(sigsq)
1977 rij_shift=1.0D0/rij-sig+r0ij
1978 C I hate to put IF's in the loops, but here don't have another choice!!!!
1979 if (rij_shift.le.0.0D0) then
1984 c---------------------------------------------------------------
1985 rij_shift=1.0D0/rij_shift
1986 fac=rij_shift**expon
1989 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1990 eps2der=evdwij*eps3rt
1991 eps3der=evdwij*eps2rt
1992 fac_augm=rrij**expon
1993 e_augm=augm(itypi,itypj)*fac_augm
1994 evdwij=evdwij*eps2rt*eps3rt
1995 evdw=evdw+evdwij+e_augm
1997 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1999 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2000 & restyp(itypi),i,restyp(itypj),j,
2001 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
2002 & chi1,chi2,chip1,chip2,
2003 & eps1,eps2rt**2,eps3rt**2,
2004 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
2007 C Calculate gradient components.
2008 e1=e1*eps1*eps2rt**2*eps3rt**2
2009 fac=-expon*(e1+evdwij)*rij_shift
2011 fac=rij*fac-2*expon*rrij*e_augm
2012 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
2013 C Calculate the radial part of the gradient
2017 C Calculate angular part of the gradient.
2023 C-----------------------------------------------------------------------------
2024 subroutine sc_angular
2025 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2026 C om12. Called by ebp, egb, and egbv.
2028 include 'COMMON.CALC'
2029 include 'COMMON.IOUNITS'
2033 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2034 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2035 om12=dxi*dxj+dyi*dyj+dzi*dzj
2037 C Calculate eps1(om12) and its derivative in om12
2038 faceps1=1.0D0-om12*chiom12
2039 faceps1_inv=1.0D0/faceps1
2040 eps1=dsqrt(faceps1_inv)
2041 C Following variable is eps1*deps1/dom12
2042 eps1_om12=faceps1_inv*chiom12
2047 c write (iout,*) "om12",om12," eps1",eps1
2048 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2053 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2054 sigsq=1.0D0-facsig*faceps1_inv
2055 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2056 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2057 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2063 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
2064 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
2066 C Calculate eps2 and its derivatives in om1, om2, and om12.
2069 chipom12=chip12*om12
2070 facp=1.0D0-om12*chipom12
2072 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2073 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2074 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2075 C Following variable is the square root of eps2
2076 eps2rt=1.0D0-facp1*facp_inv
2077 C Following three variables are the derivatives of the square root of eps
2078 C in om1, om2, and om12.
2079 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2080 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2081 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2082 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2083 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2084 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2085 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2086 c & " eps2rt_om12",eps2rt_om12
2087 C Calculate whole angle-dependent part of epsilon and contributions
2088 C to its derivatives
2091 C----------------------------------------------------------------------------
2093 implicit real*8 (a-h,o-z)
2094 include 'DIMENSIONS'
2095 include 'COMMON.CHAIN'
2096 include 'COMMON.DERIV'
2097 include 'COMMON.CALC'
2098 include 'COMMON.IOUNITS'
2099 double precision dcosom1(3),dcosom2(3)
2100 cc print *,'sss=',sss
2101 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2102 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2103 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2104 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2108 c eom12=evdwij*eps1_om12
2110 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2111 c & " sigder",sigder
2112 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2113 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2115 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2116 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2119 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
2121 c write (iout,*) "gg",(gg(k),k=1,3)
2123 gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
2124 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2125 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
2126 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
2127 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2128 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
2129 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2130 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2131 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2132 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2135 C Calculate the components of the gradient in DC and X
2139 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2143 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
2144 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
2148 C-----------------------------------------------------------------------
2149 subroutine e_softsphere(evdw)
2151 C This subroutine calculates the interaction energy of nonbonded side chains
2152 C assuming the LJ potential of interaction.
2154 implicit real*8 (a-h,o-z)
2155 include 'DIMENSIONS'
2156 parameter (accur=1.0d-10)
2157 include 'COMMON.GEO'
2158 include 'COMMON.VAR'
2159 include 'COMMON.LOCAL'
2160 include 'COMMON.CHAIN'
2161 include 'COMMON.DERIV'
2162 include 'COMMON.INTERACT'
2163 include 'COMMON.TORSION'
2164 include 'COMMON.SBRIDGE'
2165 include 'COMMON.NAMES'
2166 include 'COMMON.IOUNITS'
2167 include 'COMMON.CONTACTS'
2169 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2171 do i=iatsc_s,iatsc_e
2172 itypi=iabs(itype(i))
2173 if (itypi.eq.ntyp1) cycle
2174 itypi1=iabs(itype(i+1))
2179 C Calculate SC interaction energy.
2181 do iint=1,nint_gr(i)
2182 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2183 cd & 'iend=',iend(i,iint)
2184 do j=istart(i,iint),iend(i,iint)
2185 itypj=iabs(itype(j))
2186 if (itypj.eq.ntyp1) cycle
2190 rij=xj*xj+yj*yj+zj*zj
2191 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2192 r0ij=r0(itypi,itypj)
2194 c print *,i,j,r0ij,dsqrt(rij)
2195 if (rij.lt.r0ijsq) then
2196 evdwij=0.25d0*(rij-r0ijsq)**2
2204 C Calculate the components of the gradient in DC and X
2210 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2211 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2212 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2213 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2217 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2225 C--------------------------------------------------------------------------
2226 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2229 C Soft-sphere potential of p-p interaction
2231 implicit real*8 (a-h,o-z)
2232 include 'DIMENSIONS'
2233 include 'COMMON.CONTROL'
2234 include 'COMMON.IOUNITS'
2235 include 'COMMON.GEO'
2236 include 'COMMON.VAR'
2237 include 'COMMON.LOCAL'
2238 include 'COMMON.CHAIN'
2239 include 'COMMON.DERIV'
2240 include 'COMMON.INTERACT'
2241 include 'COMMON.CONTACTS'
2242 include 'COMMON.TORSION'
2243 include 'COMMON.VECTORS'
2244 include 'COMMON.FFIELD'
2246 C write(iout,*) 'In EELEC_soft_sphere'
2253 do i=iatel_s,iatel_e
2254 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2258 xmedi=c(1,i)+0.5d0*dxi
2259 ymedi=c(2,i)+0.5d0*dyi
2260 zmedi=c(3,i)+0.5d0*dzi
2261 xmedi=mod(xmedi,boxxsize)
2262 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2263 ymedi=mod(ymedi,boxysize)
2264 if (ymedi.lt.0) ymedi=ymedi+boxysize
2265 zmedi=mod(zmedi,boxzsize)
2266 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2268 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2269 do j=ielstart(i),ielend(i)
2270 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2274 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2275 r0ij=rpp(iteli,itelj)
2284 if (xj.lt.0) xj=xj+boxxsize
2286 if (yj.lt.0) yj=yj+boxysize
2288 if (zj.lt.0) zj=zj+boxzsize
2289 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2297 xj=xj_safe+xshift*boxxsize
2298 yj=yj_safe+yshift*boxysize
2299 zj=zj_safe+zshift*boxzsize
2300 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2301 if(dist_temp.lt.dist_init) then
2311 if (isubchap.eq.1) then
2320 rij=xj*xj+yj*yj+zj*zj
2321 sss=sscale(sqrt(rij))
2322 sssgrad=sscagrad(sqrt(rij))
2323 if (rij.lt.r0ijsq) then
2324 evdw1ij=0.25d0*(rij-r0ijsq)**2
2330 evdw1=evdw1+evdw1ij*sss
2332 C Calculate contributions to the Cartesian gradient.
2334 ggg(1)=fac*xj*sssgrad
2335 ggg(2)=fac*yj*sssgrad
2336 ggg(3)=fac*zj*sssgrad
2338 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2339 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2342 * Loop over residues i+1 thru j-1.
2346 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2351 cgrad do i=nnt,nct-1
2353 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2355 cgrad do j=i+1,nct-1
2357 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2363 c------------------------------------------------------------------------------
2364 subroutine vec_and_deriv
2365 implicit real*8 (a-h,o-z)
2366 include 'DIMENSIONS'
2370 include 'COMMON.IOUNITS'
2371 include 'COMMON.GEO'
2372 include 'COMMON.VAR'
2373 include 'COMMON.LOCAL'
2374 include 'COMMON.CHAIN'
2375 include 'COMMON.VECTORS'
2376 include 'COMMON.SETUP'
2377 include 'COMMON.TIME1'
2378 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2379 C Compute the local reference systems. For reference system (i), the
2380 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2381 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2383 do i=ivec_start,ivec_end
2387 if (i.eq.nres-1) then
2388 C Case of the last full residue
2389 C Compute the Z-axis
2390 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2391 costh=dcos(pi-theta(nres))
2392 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2396 C Compute the derivatives of uz
2398 uzder(2,1,1)=-dc_norm(3,i-1)
2399 uzder(3,1,1)= dc_norm(2,i-1)
2400 uzder(1,2,1)= dc_norm(3,i-1)
2402 uzder(3,2,1)=-dc_norm(1,i-1)
2403 uzder(1,3,1)=-dc_norm(2,i-1)
2404 uzder(2,3,1)= dc_norm(1,i-1)
2407 uzder(2,1,2)= dc_norm(3,i)
2408 uzder(3,1,2)=-dc_norm(2,i)
2409 uzder(1,2,2)=-dc_norm(3,i)
2411 uzder(3,2,2)= dc_norm(1,i)
2412 uzder(1,3,2)= dc_norm(2,i)
2413 uzder(2,3,2)=-dc_norm(1,i)
2415 C Compute the Y-axis
2418 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2420 C Compute the derivatives of uy
2423 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2424 & -dc_norm(k,i)*dc_norm(j,i-1)
2425 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2427 uyder(j,j,1)=uyder(j,j,1)-costh
2428 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2433 uygrad(l,k,j,i)=uyder(l,k,j)
2434 uzgrad(l,k,j,i)=uzder(l,k,j)
2438 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2439 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2440 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2441 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2444 C Compute the Z-axis
2445 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2446 costh=dcos(pi-theta(i+2))
2447 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2451 C Compute the derivatives of uz
2453 uzder(2,1,1)=-dc_norm(3,i+1)
2454 uzder(3,1,1)= dc_norm(2,i+1)
2455 uzder(1,2,1)= dc_norm(3,i+1)
2457 uzder(3,2,1)=-dc_norm(1,i+1)
2458 uzder(1,3,1)=-dc_norm(2,i+1)
2459 uzder(2,3,1)= dc_norm(1,i+1)
2462 uzder(2,1,2)= dc_norm(3,i)
2463 uzder(3,1,2)=-dc_norm(2,i)
2464 uzder(1,2,2)=-dc_norm(3,i)
2466 uzder(3,2,2)= dc_norm(1,i)
2467 uzder(1,3,2)= dc_norm(2,i)
2468 uzder(2,3,2)=-dc_norm(1,i)
2470 C Compute the Y-axis
2473 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2475 C Compute the derivatives of uy
2478 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2479 & -dc_norm(k,i)*dc_norm(j,i+1)
2480 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2482 uyder(j,j,1)=uyder(j,j,1)-costh
2483 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2488 uygrad(l,k,j,i)=uyder(l,k,j)
2489 uzgrad(l,k,j,i)=uzder(l,k,j)
2493 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2494 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2495 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2496 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2500 vbld_inv_temp(1)=vbld_inv(i+1)
2501 if (i.lt.nres-1) then
2502 vbld_inv_temp(2)=vbld_inv(i+2)
2504 vbld_inv_temp(2)=vbld_inv(i)
2509 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2510 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2515 #if defined(PARVEC) && defined(MPI)
2516 if (nfgtasks1.gt.1) then
2518 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2519 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2520 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2521 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2522 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2524 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2525 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2527 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2528 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2529 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2530 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2531 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2532 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2533 time_gather=time_gather+MPI_Wtime()-time00
2535 c if (fg_rank.eq.0) then
2536 c write (iout,*) "Arrays UY and UZ"
2538 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2545 C-----------------------------------------------------------------------------
2546 subroutine check_vecgrad
2547 implicit real*8 (a-h,o-z)
2548 include 'DIMENSIONS'
2549 include 'COMMON.IOUNITS'
2550 include 'COMMON.GEO'
2551 include 'COMMON.VAR'
2552 include 'COMMON.LOCAL'
2553 include 'COMMON.CHAIN'
2554 include 'COMMON.VECTORS'
2555 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2556 dimension uyt(3,maxres),uzt(3,maxres)
2557 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2558 double precision delta /1.0d-7/
2561 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2562 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2563 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2564 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2565 cd & (dc_norm(if90,i),if90=1,3)
2566 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2567 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2568 cd write(iout,'(a)')
2574 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2575 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2588 cd write (iout,*) 'i=',i
2590 erij(k)=dc_norm(k,i)
2594 dc_norm(k,i)=erij(k)
2596 dc_norm(j,i)=dc_norm(j,i)+delta
2597 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2599 c dc_norm(k,i)=dc_norm(k,i)/fac
2601 c write (iout,*) (dc_norm(k,i),k=1,3)
2602 c write (iout,*) (erij(k),k=1,3)
2605 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2606 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2607 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2608 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2610 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2611 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2612 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2615 dc_norm(k,i)=erij(k)
2618 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2619 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2620 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2621 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2622 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2623 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2624 cd write (iout,'(a)')
2629 C--------------------------------------------------------------------------
2630 subroutine set_matrices
2631 implicit real*8 (a-h,o-z)
2632 include 'DIMENSIONS'
2635 include "COMMON.SETUP"
2637 integer status(MPI_STATUS_SIZE)
2639 include 'COMMON.IOUNITS'
2640 include 'COMMON.GEO'
2641 include 'COMMON.VAR'
2642 include 'COMMON.LOCAL'
2643 include 'COMMON.CHAIN'
2644 include 'COMMON.DERIV'
2645 include 'COMMON.INTERACT'
2646 include 'COMMON.CONTACTS'
2647 include 'COMMON.TORSION'
2648 include 'COMMON.VECTORS'
2649 include 'COMMON.FFIELD'
2650 double precision auxvec(2),auxmat(2,2)
2652 C Compute the virtual-bond-torsional-angle dependent quantities needed
2653 C to calculate the el-loc multibody terms of various order.
2655 c write(iout,*) 'nphi=',nphi,nres
2657 do i=ivec_start+2,ivec_end+2
2662 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2663 iti = itortyp(itype(i-2))
2667 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2668 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2669 iti1 = itortyp(itype(i-1))
2674 b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0)
2675 & +bnew1(2,1,iti)*dsin(theta(i-1))
2676 & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0)
2677 gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2678 & +bnew1(2,1,iti)*dcos(theta(i-1))
2679 & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2680 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2681 c &*(cos(theta(i)/2.0)
2682 b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0)
2683 & +bnew2(2,1,iti)*dsin(theta(i-1))
2684 & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0)
2685 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2686 c &*(cos(theta(i)/2.0)
2687 gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2688 & +bnew2(2,1,iti)*dcos(theta(i-1))
2689 & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2690 c if (ggb1(1,i).eq.0.0d0) then
2691 c write(iout,*) 'i=',i,ggb1(1,i),
2692 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2693 c &bnew1(2,1,iti)*cos(theta(i)),
2694 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2696 b1(2,i-2)=bnew1(1,2,iti)
2698 b2(2,i-2)=bnew2(1,2,iti)
2700 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2701 EE(1,2,i-2)=eeold(1,2,iti)
2702 EE(2,1,i-2)=eeold(2,1,iti)
2703 EE(2,2,i-2)=eeold(2,2,iti)
2704 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2709 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2710 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2711 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2712 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2713 b1tilde(1,i-2)=b1(1,i-2)
2714 b1tilde(2,i-2)=-b1(2,i-2)
2715 b2tilde(1,i-2)=b2(1,i-2)
2716 b2tilde(2,i-2)=-b2(2,i-2)
2717 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2718 c write(iout,*) 'b1=',b1(1,i-2)
2719 c write (iout,*) 'theta=', theta(i-1)
2726 b1tilde(1,i-2)=b1(1,i-2)
2727 b1tilde(2,i-2)=-b1(2,i-2)
2728 b2tilde(1,i-2)=b2(1,i-2)
2729 b2tilde(2,i-2)=-b2(2,i-2)
2730 EE(1,2,i-2)=eeold(1,2,iti)
2731 EE(2,1,i-2)=eeold(2,1,iti)
2732 EE(2,2,i-2)=eeold(2,2,iti)
2733 EE(1,1,i-2)=eeold(1,1,iti)
2737 do i=ivec_start+2,ivec_end+2
2741 if (i .lt. nres+1) then
2778 if (i .gt. 3 .and. i .lt. nres+1) then
2779 obrot_der(1,i-2)=-sin1
2780 obrot_der(2,i-2)= cos1
2781 Ugder(1,1,i-2)= sin1
2782 Ugder(1,2,i-2)=-cos1
2783 Ugder(2,1,i-2)=-cos1
2784 Ugder(2,2,i-2)=-sin1
2787 obrot2_der(1,i-2)=-dwasin2
2788 obrot2_der(2,i-2)= dwacos2
2789 Ug2der(1,1,i-2)= dwasin2
2790 Ug2der(1,2,i-2)=-dwacos2
2791 Ug2der(2,1,i-2)=-dwacos2
2792 Ug2der(2,2,i-2)=-dwasin2
2794 obrot_der(1,i-2)=0.0d0
2795 obrot_der(2,i-2)=0.0d0
2796 Ugder(1,1,i-2)=0.0d0
2797 Ugder(1,2,i-2)=0.0d0
2798 Ugder(2,1,i-2)=0.0d0
2799 Ugder(2,2,i-2)=0.0d0
2800 obrot2_der(1,i-2)=0.0d0
2801 obrot2_der(2,i-2)=0.0d0
2802 Ug2der(1,1,i-2)=0.0d0
2803 Ug2der(1,2,i-2)=0.0d0
2804 Ug2der(2,1,i-2)=0.0d0
2805 Ug2der(2,2,i-2)=0.0d0
2807 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2808 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2809 iti = itortyp(itype(i-2))
2813 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2814 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2815 iti1 = itortyp(itype(i-1))
2819 cd write (iout,*) '*******i',i,' iti1',iti
2820 cd write (iout,*) 'b1',b1(:,iti)
2821 cd write (iout,*) 'b2',b2(:,iti)
2822 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2823 c if (i .gt. iatel_s+2) then
2824 if (i .gt. nnt+2) then
2825 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2827 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2828 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2830 c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
2831 c & EE(1,2,iti),EE(2,2,iti)
2832 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2833 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2834 c write(iout,*) "Macierz EUG",
2835 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2837 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2839 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2840 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2841 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2842 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2843 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2854 DtUg2(l,k,i-2)=0.0d0
2858 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2859 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2861 muder(k,i-2)=Ub2der(k,i-2)
2863 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2864 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2865 if (itype(i-1).le.ntyp) then
2866 iti1 = itortyp(itype(i-1))
2874 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2876 c write (iout,*) 'mu ',mu(:,i-2),i-2
2877 cd write (iout,*) 'mu1',mu1(:,i-2)
2878 cd write (iout,*) 'mu2',mu2(:,i-2)
2879 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2881 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2882 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2883 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2884 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2885 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2886 C Vectors and matrices dependent on a single virtual-bond dihedral.
2887 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
2888 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2889 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2890 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2891 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2892 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2893 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2894 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2895 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2898 C Matrices dependent on two consecutive virtual-bond dihedrals.
2899 C The order of matrices is from left to right.
2900 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2902 c do i=max0(ivec_start,2),ivec_end
2904 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2905 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2906 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2907 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2908 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2909 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2910 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2911 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2914 #if defined(MPI) && defined(PARMAT)
2916 c if (fg_rank.eq.0) then
2917 write (iout,*) "Arrays UG and UGDER before GATHER"
2919 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2920 & ((ug(l,k,i),l=1,2),k=1,2),
2921 & ((ugder(l,k,i),l=1,2),k=1,2)
2923 write (iout,*) "Arrays UG2 and UG2DER"
2925 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2926 & ((ug2(l,k,i),l=1,2),k=1,2),
2927 & ((ug2der(l,k,i),l=1,2),k=1,2)
2929 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2931 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2932 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2933 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2935 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2937 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2938 & costab(i),sintab(i),costab2(i),sintab2(i)
2940 write (iout,*) "Array MUDER"
2942 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2946 if (nfgtasks.gt.1) then
2948 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2949 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2950 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2952 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2953 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2955 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2956 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2958 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2959 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2961 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2962 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2964 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2965 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2967 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2968 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2970 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2971 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2972 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2973 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2974 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2975 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2976 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2977 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2978 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2979 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2980 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2981 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2982 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2984 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2985 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2987 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2988 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2990 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2991 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2993 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2994 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2996 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2997 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2999 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
3000 & ivec_count(fg_rank1),
3001 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3003 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
3004 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3006 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
3007 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3009 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
3010 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3012 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
3013 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3015 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
3016 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3018 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
3019 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3021 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
3022 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3024 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
3025 & ivec_count(fg_rank1),
3026 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3028 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
3029 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3031 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
3032 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3034 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
3035 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3037 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
3038 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3040 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
3041 & ivec_count(fg_rank1),
3042 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3044 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
3045 & ivec_count(fg_rank1),
3046 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3048 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
3049 & ivec_count(fg_rank1),
3050 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3051 & MPI_MAT2,FG_COMM1,IERR)
3052 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
3053 & ivec_count(fg_rank1),
3054 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3055 & MPI_MAT2,FG_COMM1,IERR)
3058 c Passes matrix info through the ring
3061 if (irecv.lt.0) irecv=nfgtasks1-1
3064 if (inext.ge.nfgtasks1) inext=0
3066 c write (iout,*) "isend",isend," irecv",irecv
3068 lensend=lentyp(isend)
3069 lenrecv=lentyp(irecv)
3070 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
3071 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3072 c & MPI_ROTAT1(lensend),inext,2200+isend,
3073 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3074 c & iprev,2200+irecv,FG_COMM,status,IERR)
3075 c write (iout,*) "Gather ROTAT1"
3077 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3078 c & MPI_ROTAT2(lensend),inext,3300+isend,
3079 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3080 c & iprev,3300+irecv,FG_COMM,status,IERR)
3081 c write (iout,*) "Gather ROTAT2"
3083 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
3084 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
3085 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
3086 & iprev,4400+irecv,FG_COMM,status,IERR)
3087 c write (iout,*) "Gather ROTAT_OLD"
3089 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
3090 & MPI_PRECOMP11(lensend),inext,5500+isend,
3091 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
3092 & iprev,5500+irecv,FG_COMM,status,IERR)
3093 c write (iout,*) "Gather PRECOMP11"
3095 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
3096 & MPI_PRECOMP12(lensend),inext,6600+isend,
3097 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
3098 & iprev,6600+irecv,FG_COMM,status,IERR)
3099 c write (iout,*) "Gather PRECOMP12"
3101 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3103 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
3104 & MPI_ROTAT2(lensend),inext,7700+isend,
3105 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3106 & iprev,7700+irecv,FG_COMM,status,IERR)
3107 c write (iout,*) "Gather PRECOMP21"
3109 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
3110 & MPI_PRECOMP22(lensend),inext,8800+isend,
3111 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
3112 & iprev,8800+irecv,FG_COMM,status,IERR)
3113 c write (iout,*) "Gather PRECOMP22"
3115 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
3116 & MPI_PRECOMP23(lensend),inext,9900+isend,
3117 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
3118 & MPI_PRECOMP23(lenrecv),
3119 & iprev,9900+irecv,FG_COMM,status,IERR)
3120 c write (iout,*) "Gather PRECOMP23"
3125 if (irecv.lt.0) irecv=nfgtasks1-1
3128 time_gather=time_gather+MPI_Wtime()-time00
3131 c if (fg_rank.eq.0) then
3132 write (iout,*) "Arrays UG and UGDER"
3134 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3135 & ((ug(l,k,i),l=1,2),k=1,2),
3136 & ((ugder(l,k,i),l=1,2),k=1,2)
3138 write (iout,*) "Arrays UG2 and UG2DER"
3140 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3141 & ((ug2(l,k,i),l=1,2),k=1,2),
3142 & ((ug2der(l,k,i),l=1,2),k=1,2)
3144 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3146 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3147 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3148 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3150 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3152 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3153 & costab(i),sintab(i),costab2(i),sintab2(i)
3155 write (iout,*) "Array MUDER"
3157 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3163 cd iti = itortyp(itype(i))
3166 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3167 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3172 C--------------------------------------------------------------------------
3173 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3175 C This subroutine calculates the average interaction energy and its gradient
3176 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3177 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3178 C The potential depends both on the distance of peptide-group centers and on
3179 C the orientation of the CA-CA virtual bonds.
3181 implicit real*8 (a-h,o-z)
3185 include 'DIMENSIONS'
3186 include 'COMMON.CONTROL'
3187 include 'COMMON.SETUP'
3188 include 'COMMON.IOUNITS'
3189 include 'COMMON.GEO'
3190 include 'COMMON.VAR'
3191 include 'COMMON.LOCAL'
3192 include 'COMMON.CHAIN'
3193 include 'COMMON.DERIV'
3194 include 'COMMON.INTERACT'
3195 include 'COMMON.CONTACTS'
3196 include 'COMMON.TORSION'
3197 include 'COMMON.VECTORS'
3198 include 'COMMON.FFIELD'
3199 include 'COMMON.TIME1'
3200 include 'COMMON.SPLITELE'
3201 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3202 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3203 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3204 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3205 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3206 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3208 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3210 double precision scal_el /1.0d0/
3212 double precision scal_el /0.5d0/
3215 C 13-go grudnia roku pamietnego...
3216 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3217 & 0.0d0,1.0d0,0.0d0,
3218 & 0.0d0,0.0d0,1.0d0/
3219 cd write(iout,*) 'In EELEC'
3221 cd write(iout,*) 'Type',i
3222 cd write(iout,*) 'B1',B1(:,i)
3223 cd write(iout,*) 'B2',B2(:,i)
3224 cd write(iout,*) 'CC',CC(:,:,i)
3225 cd write(iout,*) 'DD',DD(:,:,i)
3226 cd write(iout,*) 'EE',EE(:,:,i)
3228 cd call check_vecgrad
3230 if (icheckgrad.eq.1) then
3232 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3234 dc_norm(k,i)=dc(k,i)*fac
3236 c write (iout,*) 'i',i,' fac',fac
3239 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3240 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3241 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3242 c call vec_and_deriv
3248 time_mat=time_mat+MPI_Wtime()-time01
3252 cd write (iout,*) 'i=',i
3254 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3257 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3258 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3271 cd print '(a)','Enter EELEC'
3272 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3274 gel_loc_loc(i)=0.0d0
3279 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3281 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3283 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3284 do i=iturn3_start,iturn3_end
3286 C write(iout,*) "tu jest i",i
3287 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3288 C changes suggested by Ana to avoid out of bounds
3289 & .or.((i+4).gt.nres)
3291 C end of changes by Ana
3292 & .or. itype(i+2).eq.ntyp1
3293 & .or. itype(i+3).eq.ntyp1) cycle
3295 if(itype(i-1).eq.ntyp1)cycle
3298 if (itype(i+4).eq.ntyp1) cycle
3303 dx_normi=dc_norm(1,i)
3304 dy_normi=dc_norm(2,i)
3305 dz_normi=dc_norm(3,i)
3306 xmedi=c(1,i)+0.5d0*dxi
3307 ymedi=c(2,i)+0.5d0*dyi
3308 zmedi=c(3,i)+0.5d0*dzi
3309 xmedi=mod(xmedi,boxxsize)
3310 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3311 ymedi=mod(ymedi,boxysize)
3312 if (ymedi.lt.0) ymedi=ymedi+boxysize
3313 zmedi=mod(zmedi,boxzsize)
3314 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3316 call eelecij(i,i+2,ees,evdw1,eel_loc)
3317 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3318 num_cont_hb(i)=num_conti
3320 do i=iturn4_start,iturn4_end
3322 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3323 C changes suggested by Ana to avoid out of bounds
3324 & .or.((i+5).gt.nres)
3326 C end of changes suggested by Ana
3327 & .or. itype(i+3).eq.ntyp1
3328 & .or. itype(i+4).eq.ntyp1
3329 & .or. itype(i+5).eq.ntyp1
3330 & .or. itype(i).eq.ntyp1
3331 & .or. itype(i-1).eq.ntyp1
3336 dx_normi=dc_norm(1,i)
3337 dy_normi=dc_norm(2,i)
3338 dz_normi=dc_norm(3,i)
3339 xmedi=c(1,i)+0.5d0*dxi
3340 ymedi=c(2,i)+0.5d0*dyi
3341 zmedi=c(3,i)+0.5d0*dzi
3342 C Return atom into box, boxxsize is size of box in x dimension
3344 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3345 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3346 C Condition for being inside the proper box
3347 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3348 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3352 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3353 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3354 C Condition for being inside the proper box
3355 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3356 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3360 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3361 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3362 C Condition for being inside the proper box
3363 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3364 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3367 xmedi=mod(xmedi,boxxsize)
3368 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3369 ymedi=mod(ymedi,boxysize)
3370 if (ymedi.lt.0) ymedi=ymedi+boxysize
3371 zmedi=mod(zmedi,boxzsize)
3372 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3374 num_conti=num_cont_hb(i)
3375 c write(iout,*) "JESTEM W PETLI"
3376 call eelecij(i,i+3,ees,evdw1,eel_loc)
3377 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3378 & call eturn4(i,eello_turn4)
3379 num_cont_hb(i)=num_conti
3381 C Loop over all neighbouring boxes
3386 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3388 do i=iatel_s,iatel_e
3390 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3391 C changes suggested by Ana to avoid out of bounds
3392 & .or.((i+2).gt.nres)
3394 C end of changes by Ana
3395 & .or. itype(i+2).eq.ntyp1
3396 & .or. itype(i-1).eq.ntyp1
3401 dx_normi=dc_norm(1,i)
3402 dy_normi=dc_norm(2,i)
3403 dz_normi=dc_norm(3,i)
3404 xmedi=c(1,i)+0.5d0*dxi
3405 ymedi=c(2,i)+0.5d0*dyi
3406 zmedi=c(3,i)+0.5d0*dzi
3407 xmedi=mod(xmedi,boxxsize)
3408 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3409 ymedi=mod(ymedi,boxysize)
3410 if (ymedi.lt.0) ymedi=ymedi+boxysize
3411 zmedi=mod(zmedi,boxzsize)
3412 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3413 C xmedi=xmedi+xshift*boxxsize
3414 C ymedi=ymedi+yshift*boxysize
3415 C zmedi=zmedi+zshift*boxzsize
3417 C Return tom into box, boxxsize is size of box in x dimension
3419 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3420 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3421 C Condition for being inside the proper box
3422 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3423 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3427 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3428 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3429 C Condition for being inside the proper box
3430 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3431 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3435 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3436 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3437 cC Condition for being inside the proper box
3438 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3439 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3443 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3444 num_conti=num_cont_hb(i)
3445 do j=ielstart(i),ielend(i)
3446 C write (iout,*) i,j
3448 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3449 C changes suggested by Ana to avoid out of bounds
3450 & .or.((j+2).gt.nres)
3452 C end of changes by Ana
3453 & .or.itype(j+2).eq.ntyp1
3454 & .or.itype(j-1).eq.ntyp1
3456 call eelecij(i,j,ees,evdw1,eel_loc)
3458 num_cont_hb(i)=num_conti
3464 c write (iout,*) "Number of loop steps in EELEC:",ind
3466 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3467 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3469 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3470 ccc eel_loc=eel_loc+eello_turn3
3471 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3474 C-------------------------------------------------------------------------------
3475 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3476 implicit real*8 (a-h,o-z)
3477 include 'DIMENSIONS'
3481 include 'COMMON.CONTROL'
3482 include 'COMMON.IOUNITS'
3483 include 'COMMON.GEO'
3484 include 'COMMON.VAR'
3485 include 'COMMON.LOCAL'
3486 include 'COMMON.CHAIN'
3487 include 'COMMON.DERIV'
3488 include 'COMMON.INTERACT'
3489 include 'COMMON.CONTACTS'
3490 include 'COMMON.TORSION'
3491 include 'COMMON.VECTORS'
3492 include 'COMMON.FFIELD'
3493 include 'COMMON.TIME1'
3494 include 'COMMON.SPLITELE'
3495 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3496 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3497 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3498 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3499 & gmuij2(4),gmuji2(4)
3500 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3501 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3503 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3505 double precision scal_el /1.0d0/
3507 double precision scal_el /0.5d0/
3510 C 13-go grudnia roku pamietnego...
3511 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3512 & 0.0d0,1.0d0,0.0d0,
3513 & 0.0d0,0.0d0,1.0d0/
3514 c time00=MPI_Wtime()
3515 cd write (iout,*) "eelecij",i,j
3519 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3520 aaa=app(iteli,itelj)
3521 bbb=bpp(iteli,itelj)
3522 ael6i=ael6(iteli,itelj)
3523 ael3i=ael3(iteli,itelj)
3527 dx_normj=dc_norm(1,j)
3528 dy_normj=dc_norm(2,j)
3529 dz_normj=dc_norm(3,j)
3530 C xj=c(1,j)+0.5D0*dxj-xmedi
3531 C yj=c(2,j)+0.5D0*dyj-ymedi
3532 C zj=c(3,j)+0.5D0*dzj-zmedi
3537 if (xj.lt.0) xj=xj+boxxsize
3539 if (yj.lt.0) yj=yj+boxysize
3541 if (zj.lt.0) zj=zj+boxzsize
3542 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3543 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3551 xj=xj_safe+xshift*boxxsize
3552 yj=yj_safe+yshift*boxysize
3553 zj=zj_safe+zshift*boxzsize
3554 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3555 if(dist_temp.lt.dist_init) then
3565 if (isubchap.eq.1) then
3574 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3576 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3577 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3578 C Condition for being inside the proper box
3579 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3580 c & (xj.lt.((-0.5d0)*boxxsize))) then
3584 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3585 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3586 C Condition for being inside the proper box
3587 c if ((yj.gt.((0.5d0)*boxysize)).or.
3588 c & (yj.lt.((-0.5d0)*boxysize))) then
3592 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3593 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3594 C Condition for being inside the proper box
3595 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3596 c & (zj.lt.((-0.5d0)*boxzsize))) then
3599 C endif !endPBC condintion
3603 rij=xj*xj+yj*yj+zj*zj
3605 sss=sscale(sqrt(rij))
3606 sssgrad=sscagrad(sqrt(rij))
3607 c if (sss.gt.0.0d0) then
3613 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3614 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3615 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3616 fac=cosa-3.0D0*cosb*cosg
3618 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3619 if (j.eq.i+2) ev1=scal_el*ev1
3624 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3628 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3629 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3631 evdw1=evdw1+evdwij*sss
3632 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3633 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3634 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3635 cd & xmedi,ymedi,zmedi,xj,yj,zj
3637 if (energy_dec) then
3638 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3640 &,iteli,itelj,aaa,evdw1
3641 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3645 C Calculate contributions to the Cartesian gradient.
3648 facvdw=-6*rrmij*(ev1+evdwij)*sss
3649 facel=-3*rrmij*(el1+eesij)
3655 * Radial derivatives. First process both termini of the fragment (i,j)
3661 c ghalf=0.5D0*ggg(k)
3662 c gelc(k,i)=gelc(k,i)+ghalf
3663 c gelc(k,j)=gelc(k,j)+ghalf
3665 c 9/28/08 AL Gradient compotents will be summed only at the end
3667 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3668 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3671 * Loop over residues i+1 thru j-1.
3675 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3678 if (sss.gt.0.0) then
3679 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3680 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3681 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3688 c ghalf=0.5D0*ggg(k)
3689 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3690 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3692 c 9/28/08 AL Gradient compotents will be summed only at the end
3694 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3695 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3698 * Loop over residues i+1 thru j-1.
3702 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3707 facvdw=(ev1+evdwij)*sss
3710 fac=-3*rrmij*(facvdw+facvdw+facel)
3715 * Radial derivatives. First process both termini of the fragment (i,j)
3721 c ghalf=0.5D0*ggg(k)
3722 c gelc(k,i)=gelc(k,i)+ghalf
3723 c gelc(k,j)=gelc(k,j)+ghalf
3725 c 9/28/08 AL Gradient compotents will be summed only at the end
3727 gelc_long(k,j)=gelc(k,j)+ggg(k)
3728 gelc_long(k,i)=gelc(k,i)-ggg(k)
3731 * Loop over residues i+1 thru j-1.
3735 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3738 c 9/28/08 AL Gradient compotents will be summed only at the end
3739 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3740 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3741 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3743 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3744 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3750 ecosa=2.0D0*fac3*fac1+fac4
3753 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3754 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3756 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3757 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3759 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3760 cd & (dcosg(k),k=1,3)
3762 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3765 c ghalf=0.5D0*ggg(k)
3766 c gelc(k,i)=gelc(k,i)+ghalf
3767 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3768 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3769 c gelc(k,j)=gelc(k,j)+ghalf
3770 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3771 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3775 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3780 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3781 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3783 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3784 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3785 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3786 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3790 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3791 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3792 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3794 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3795 C energy of a peptide unit is assumed in the form of a second-order
3796 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3797 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3798 C are computed for EVERY pair of non-contiguous peptide groups.
3801 if (j.lt.nres-1) then
3813 muij(kkk)=mu(k,i)*mu(l,j)
3814 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
3816 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
3817 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
3818 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
3819 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
3820 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
3821 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
3825 cd write (iout,*) 'EELEC: i',i,' j',j
3826 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3827 cd write(iout,*) 'muij',muij
3828 ury=scalar(uy(1,i),erij)
3829 urz=scalar(uz(1,i),erij)
3830 vry=scalar(uy(1,j),erij)
3831 vrz=scalar(uz(1,j),erij)
3832 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3833 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3834 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3835 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3836 fac=dsqrt(-ael6i)*r3ij
3841 cd write (iout,'(4i5,4f10.5)')
3842 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3843 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3844 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3845 cd & uy(:,j),uz(:,j)
3846 cd write (iout,'(4f10.5)')
3847 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3848 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3849 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3850 cd write (iout,'(9f10.5/)')
3851 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3852 C Derivatives of the elements of A in virtual-bond vectors
3853 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3855 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3856 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3857 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3858 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3859 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3860 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3861 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3862 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3863 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3864 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3865 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3866 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3868 C Compute radial contributions to the gradient
3886 C Add the contributions coming from er
3889 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3890 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3891 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3892 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3895 C Derivatives in DC(i)
3896 cgrad ghalf1=0.5d0*agg(k,1)
3897 cgrad ghalf2=0.5d0*agg(k,2)
3898 cgrad ghalf3=0.5d0*agg(k,3)
3899 cgrad ghalf4=0.5d0*agg(k,4)
3900 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3901 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3902 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3903 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3904 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3905 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3906 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3907 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3908 C Derivatives in DC(i+1)
3909 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3910 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3911 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3912 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3913 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3914 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3915 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3916 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3917 C Derivatives in DC(j)
3918 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3919 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3920 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3921 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3922 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3923 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3924 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3925 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3926 C Derivatives in DC(j+1) or DC(nres-1)
3927 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3928 & -3.0d0*vryg(k,3)*ury)
3929 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3930 & -3.0d0*vrzg(k,3)*ury)
3931 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3932 & -3.0d0*vryg(k,3)*urz)
3933 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3934 & -3.0d0*vrzg(k,3)*urz)
3935 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3937 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3950 aggi(k,l)=-aggi(k,l)
3951 aggi1(k,l)=-aggi1(k,l)
3952 aggj(k,l)=-aggj(k,l)
3953 aggj1(k,l)=-aggj1(k,l)
3956 if (j.lt.nres-1) then
3962 aggi(k,l)=-aggi(k,l)
3963 aggi1(k,l)=-aggi1(k,l)
3964 aggj(k,l)=-aggj(k,l)
3965 aggj1(k,l)=-aggj1(k,l)
3976 aggi(k,l)=-aggi(k,l)
3977 aggi1(k,l)=-aggi1(k,l)
3978 aggj(k,l)=-aggj(k,l)
3979 aggj1(k,l)=-aggj1(k,l)
3984 IF (wel_loc.gt.0.0d0) THEN
3985 C Contribution to the local-electrostatic energy coming from the i-j pair
3986 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3988 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3989 c & ' eel_loc_ij',eel_loc_ij
3990 c write(iout,*) 'muije=',muij(1),muij(2),muij(3),muij(4)
3991 C Calculate patrial derivative for theta angle
3993 geel_loc_ij=a22*gmuij1(1)
3997 c write(iout,*) "derivative over thatai"
3998 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4000 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
4001 & geel_loc_ij*wel_loc
4002 c write(iout,*) "derivative over thatai-1"
4003 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4010 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4011 & geel_loc_ij*wel_loc
4012 c Derivative over j residue
4013 geel_loc_ji=a22*gmuji1(1)
4017 c write(iout,*) "derivative over thataj"
4018 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4021 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4022 & geel_loc_ji*wel_loc
4028 c write(iout,*) "derivative over thataj-1"
4029 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4031 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4032 & geel_loc_ji*wel_loc
4034 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4036 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4037 & 'eelloc',i,j,eel_loc_ij
4038 c if (eel_loc_ij.ne.0)
4039 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4040 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4042 eel_loc=eel_loc+eel_loc_ij
4043 C Partial derivatives in virtual-bond dihedral angles gamma
4045 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4046 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4047 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
4048 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4049 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4050 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
4051 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4053 ggg(l)=agg(l,1)*muij(1)+
4054 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
4055 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4056 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4057 cgrad ghalf=0.5d0*ggg(l)
4058 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4059 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4063 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4066 C Remaining derivatives of eello
4068 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4069 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4070 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4071 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4072 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4073 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4074 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4075 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4078 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4079 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4080 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4081 & .and. num_conti.le.maxconts) then
4082 c write (iout,*) i,j," entered corr"
4084 C Calculate the contact function. The ith column of the array JCONT will
4085 C contain the numbers of atoms that make contacts with the atom I (of numbers
4086 C greater than I). The arrays FACONT and GACONT will contain the values of
4087 C the contact function and its derivative.
4088 c r0ij=1.02D0*rpp(iteli,itelj)
4089 c r0ij=1.11D0*rpp(iteli,itelj)
4090 r0ij=2.20D0*rpp(iteli,itelj)
4091 c r0ij=1.55D0*rpp(iteli,itelj)
4092 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4093 if (fcont.gt.0.0D0) then
4094 num_conti=num_conti+1
4095 if (num_conti.gt.maxconts) then
4096 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4097 & ' will skip next contacts for this conf.'
4099 jcont_hb(num_conti,i)=j
4100 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4101 cd & " jcont_hb",jcont_hb(num_conti,i)
4102 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4103 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4104 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4106 d_cont(num_conti,i)=rij
4107 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4108 C --- Electrostatic-interaction matrix ---
4109 a_chuj(1,1,num_conti,i)=a22
4110 a_chuj(1,2,num_conti,i)=a23
4111 a_chuj(2,1,num_conti,i)=a32
4112 a_chuj(2,2,num_conti,i)=a33
4113 C --- Gradient of rij
4115 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4122 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4123 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4124 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4125 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4126 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4131 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4132 C Calculate contact energies
4134 wij=cosa-3.0D0*cosb*cosg
4137 c fac3=dsqrt(-ael6i)/r0ij**3
4138 fac3=dsqrt(-ael6i)*r3ij
4139 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4140 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4141 if (ees0tmp.gt.0) then
4142 ees0pij=dsqrt(ees0tmp)
4146 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4147 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4148 if (ees0tmp.gt.0) then
4149 ees0mij=dsqrt(ees0tmp)
4154 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4155 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4156 C Diagnostics. Comment out or remove after debugging!
4157 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4158 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4159 c ees0m(num_conti,i)=0.0D0
4161 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4162 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4163 C Angular derivatives of the contact function
4164 ees0pij1=fac3/ees0pij
4165 ees0mij1=fac3/ees0mij
4166 fac3p=-3.0D0*fac3*rrmij
4167 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4168 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4170 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4171 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4172 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4173 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4174 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4175 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4176 ecosap=ecosa1+ecosa2
4177 ecosbp=ecosb1+ecosb2
4178 ecosgp=ecosg1+ecosg2
4179 ecosam=ecosa1-ecosa2
4180 ecosbm=ecosb1-ecosb2
4181 ecosgm=ecosg1-ecosg2
4190 facont_hb(num_conti,i)=fcont
4191 fprimcont=fprimcont/rij
4192 cd facont_hb(num_conti,i)=1.0D0
4193 C Following line is for diagnostics.
4196 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4197 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4200 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4201 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4203 gggp(1)=gggp(1)+ees0pijp*xj
4204 gggp(2)=gggp(2)+ees0pijp*yj
4205 gggp(3)=gggp(3)+ees0pijp*zj
4206 gggm(1)=gggm(1)+ees0mijp*xj
4207 gggm(2)=gggm(2)+ees0mijp*yj
4208 gggm(3)=gggm(3)+ees0mijp*zj
4209 C Derivatives due to the contact function
4210 gacont_hbr(1,num_conti,i)=fprimcont*xj
4211 gacont_hbr(2,num_conti,i)=fprimcont*yj
4212 gacont_hbr(3,num_conti,i)=fprimcont*zj
4215 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4216 c following the change of gradient-summation algorithm.
4218 cgrad ghalfp=0.5D0*gggp(k)
4219 cgrad ghalfm=0.5D0*gggm(k)
4220 gacontp_hb1(k,num_conti,i)=!ghalfp
4221 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4222 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4223 gacontp_hb2(k,num_conti,i)=!ghalfp
4224 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4225 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4226 gacontp_hb3(k,num_conti,i)=gggp(k)
4227 gacontm_hb1(k,num_conti,i)=!ghalfm
4228 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4229 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4230 gacontm_hb2(k,num_conti,i)=!ghalfm
4231 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4232 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4233 gacontm_hb3(k,num_conti,i)=gggm(k)
4235 C Diagnostics. Comment out or remove after debugging!
4237 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4238 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4239 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4240 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4241 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4242 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4245 endif ! num_conti.le.maxconts
4248 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4251 ghalf=0.5d0*agg(l,k)
4252 aggi(l,k)=aggi(l,k)+ghalf
4253 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4254 aggj(l,k)=aggj(l,k)+ghalf
4257 if (j.eq.nres-1 .and. i.lt.j-2) then
4260 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4265 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4268 C-----------------------------------------------------------------------------
4269 subroutine eturn3(i,eello_turn3)
4270 C Third- and fourth-order contributions from turns
4271 implicit real*8 (a-h,o-z)
4272 include 'DIMENSIONS'
4273 include 'COMMON.IOUNITS'
4274 include 'COMMON.GEO'
4275 include 'COMMON.VAR'
4276 include 'COMMON.LOCAL'
4277 include 'COMMON.CHAIN'
4278 include 'COMMON.DERIV'
4279 include 'COMMON.INTERACT'
4280 include 'COMMON.CONTACTS'
4281 include 'COMMON.TORSION'
4282 include 'COMMON.VECTORS'
4283 include 'COMMON.FFIELD'
4284 include 'COMMON.CONTROL'
4286 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4287 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4288 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4289 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4290 & auxgmat2(2,2),auxgmatt2(2,2)
4291 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4292 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4293 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4294 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4297 c write (iout,*) "eturn3",i,j,j1,j2
4302 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4304 C Third-order contributions
4311 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4312 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4313 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4314 c auxalary matices for theta gradient
4315 c auxalary matrix for i+1 and constant i+2
4316 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4317 c auxalary matrix for i+2 and constant i+1
4318 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4319 call transpose2(auxmat(1,1),auxmat1(1,1))
4320 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4321 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4322 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4323 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4324 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4325 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4326 C Derivatives in theta
4327 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4328 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4329 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4330 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4332 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4333 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4334 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4335 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4336 cd & ' eello_turn3_num',4*eello_turn3_num
4337 C Derivatives in gamma(i)
4338 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4339 call transpose2(auxmat2(1,1),auxmat3(1,1))
4340 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4341 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4342 C Derivatives in gamma(i+1)
4343 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4344 call transpose2(auxmat2(1,1),auxmat3(1,1))
4345 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4346 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4347 & +0.5d0*(pizda(1,1)+pizda(2,2))
4348 C Cartesian derivatives
4350 c ghalf1=0.5d0*agg(l,1)
4351 c ghalf2=0.5d0*agg(l,2)
4352 c ghalf3=0.5d0*agg(l,3)
4353 c ghalf4=0.5d0*agg(l,4)
4354 a_temp(1,1)=aggi(l,1)!+ghalf1
4355 a_temp(1,2)=aggi(l,2)!+ghalf2
4356 a_temp(2,1)=aggi(l,3)!+ghalf3
4357 a_temp(2,2)=aggi(l,4)!+ghalf4
4358 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4359 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4360 & +0.5d0*(pizda(1,1)+pizda(2,2))
4361 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4362 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4363 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4364 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4365 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4366 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4367 & +0.5d0*(pizda(1,1)+pizda(2,2))
4368 a_temp(1,1)=aggj(l,1)!+ghalf1
4369 a_temp(1,2)=aggj(l,2)!+ghalf2
4370 a_temp(2,1)=aggj(l,3)!+ghalf3
4371 a_temp(2,2)=aggj(l,4)!+ghalf4
4372 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4373 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4374 & +0.5d0*(pizda(1,1)+pizda(2,2))
4375 a_temp(1,1)=aggj1(l,1)
4376 a_temp(1,2)=aggj1(l,2)
4377 a_temp(2,1)=aggj1(l,3)
4378 a_temp(2,2)=aggj1(l,4)
4379 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4380 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4381 & +0.5d0*(pizda(1,1)+pizda(2,2))
4385 C-------------------------------------------------------------------------------
4386 subroutine eturn4(i,eello_turn4)
4387 C Third- and fourth-order contributions from turns
4388 implicit real*8 (a-h,o-z)
4389 include 'DIMENSIONS'
4390 include 'COMMON.IOUNITS'
4391 include 'COMMON.GEO'
4392 include 'COMMON.VAR'
4393 include 'COMMON.LOCAL'
4394 include 'COMMON.CHAIN'
4395 include 'COMMON.DERIV'
4396 include 'COMMON.INTERACT'
4397 include 'COMMON.CONTACTS'
4398 include 'COMMON.TORSION'
4399 include 'COMMON.VECTORS'
4400 include 'COMMON.FFIELD'
4401 include 'COMMON.CONTROL'
4403 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4404 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4405 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4406 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4407 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4408 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4409 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4410 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4411 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4412 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4413 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4416 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4418 C Fourth-order contributions
4426 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4427 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4428 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4429 c write(iout,*)"WCHODZE W PROGRAM"
4434 iti1=itortyp(itype(i+1))
4435 iti2=itortyp(itype(i+2))
4436 iti3=itortyp(itype(i+3))
4437 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4438 call transpose2(EUg(1,1,i+1),e1t(1,1))
4439 call transpose2(Eug(1,1,i+2),e2t(1,1))
4440 call transpose2(Eug(1,1,i+3),e3t(1,1))
4441 C Ematrix derivative in theta
4442 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4443 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4444 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4445 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4446 c eta1 in derivative theta
4447 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4448 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4449 c auxgvec is derivative of Ub2 so i+3 theta
4450 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4451 c auxalary matrix of E i+1
4452 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4455 s1=scalar2(b1(1,i+2),auxvec(1))
4456 c derivative of theta i+2 with constant i+3
4457 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4458 c derivative of theta i+2 with constant i+2
4459 gs32=scalar2(b1(1,i+2),auxgvec(1))
4460 c derivative of E matix in theta of i+1
4461 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4463 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4464 c ea31 in derivative theta
4465 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4466 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4467 c auxilary matrix auxgvec of Ub2 with constant E matirx
4468 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4469 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4470 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4474 s2=scalar2(b1(1,i+1),auxvec(1))
4475 c derivative of theta i+1 with constant i+3
4476 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4477 c derivative of theta i+2 with constant i+1
4478 gs21=scalar2(b1(1,i+1),auxgvec(1))
4479 c derivative of theta i+3 with constant i+1
4480 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4481 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4483 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4484 c two derivatives over diffetent matrices
4485 c gtae3e2 is derivative over i+3
4486 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4487 c ae3gte2 is derivative over i+2
4488 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4489 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4490 c three possible derivative over theta E matices
4492 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4494 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4496 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4497 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4499 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4500 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4501 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4503 eello_turn4=eello_turn4-(s1+s2+s3)
4504 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4505 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4506 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4507 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4508 cd & ' eello_turn4_num',8*eello_turn4_num
4510 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4511 & -(gs13+gsE13+gsEE1)*wturn4
4512 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
4513 & -(gs23+gs21+gsEE2)*wturn4
4514 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
4515 & -(gs32+gsE31+gsEE3)*wturn4
4516 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
4519 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4520 & 'eturn4',i,j,-(s1+s2+s3)
4521 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4522 c & ' eello_turn4_num',8*eello_turn4_num
4523 C Derivatives in gamma(i)
4524 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4525 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4526 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4527 s1=scalar2(b1(1,i+2),auxvec(1))
4528 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4529 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4530 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4531 C Derivatives in gamma(i+1)
4532 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4533 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4534 s2=scalar2(b1(1,i+1),auxvec(1))
4535 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4536 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4537 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4538 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4539 C Derivatives in gamma(i+2)
4540 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4541 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4542 s1=scalar2(b1(1,i+2),auxvec(1))
4543 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4544 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4545 s2=scalar2(b1(1,i+1),auxvec(1))
4546 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4547 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4548 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4549 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4550 C Cartesian derivatives
4551 C Derivatives of this turn contributions in DC(i+2)
4552 if (j.lt.nres-1) then
4554 a_temp(1,1)=agg(l,1)
4555 a_temp(1,2)=agg(l,2)
4556 a_temp(2,1)=agg(l,3)
4557 a_temp(2,2)=agg(l,4)
4558 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4559 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4560 s1=scalar2(b1(1,i+2),auxvec(1))
4561 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4562 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4563 s2=scalar2(b1(1,i+1),auxvec(1))
4564 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4565 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4566 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4568 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4571 C Remaining derivatives of this turn contribution
4573 a_temp(1,1)=aggi(l,1)
4574 a_temp(1,2)=aggi(l,2)
4575 a_temp(2,1)=aggi(l,3)
4576 a_temp(2,2)=aggi(l,4)
4577 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4578 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4579 s1=scalar2(b1(1,i+2),auxvec(1))
4580 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4581 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4582 s2=scalar2(b1(1,i+1),auxvec(1))
4583 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4584 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4585 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4586 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4587 a_temp(1,1)=aggi1(l,1)
4588 a_temp(1,2)=aggi1(l,2)
4589 a_temp(2,1)=aggi1(l,3)
4590 a_temp(2,2)=aggi1(l,4)
4591 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4592 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4593 s1=scalar2(b1(1,i+2),auxvec(1))
4594 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4595 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4596 s2=scalar2(b1(1,i+1),auxvec(1))
4597 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4598 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4599 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4600 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4601 a_temp(1,1)=aggj(l,1)
4602 a_temp(1,2)=aggj(l,2)
4603 a_temp(2,1)=aggj(l,3)
4604 a_temp(2,2)=aggj(l,4)
4605 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4606 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4607 s1=scalar2(b1(1,i+2),auxvec(1))
4608 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4609 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4610 s2=scalar2(b1(1,i+1),auxvec(1))
4611 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4612 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4613 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4614 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4615 a_temp(1,1)=aggj1(l,1)
4616 a_temp(1,2)=aggj1(l,2)
4617 a_temp(2,1)=aggj1(l,3)
4618 a_temp(2,2)=aggj1(l,4)
4619 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4620 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4621 s1=scalar2(b1(1,i+2),auxvec(1))
4622 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4623 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4624 s2=scalar2(b1(1,i+1),auxvec(1))
4625 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4626 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4627 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4628 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4629 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4633 C-----------------------------------------------------------------------------
4634 subroutine vecpr(u,v,w)
4635 implicit real*8(a-h,o-z)
4636 dimension u(3),v(3),w(3)
4637 w(1)=u(2)*v(3)-u(3)*v(2)
4638 w(2)=-u(1)*v(3)+u(3)*v(1)
4639 w(3)=u(1)*v(2)-u(2)*v(1)
4642 C-----------------------------------------------------------------------------
4643 subroutine unormderiv(u,ugrad,unorm,ungrad)
4644 C This subroutine computes the derivatives of a normalized vector u, given
4645 C the derivatives computed without normalization conditions, ugrad. Returns
4648 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4649 double precision vec(3)
4650 double precision scalar
4652 c write (2,*) 'ugrad',ugrad
4655 vec(i)=scalar(ugrad(1,i),u(1))
4657 c write (2,*) 'vec',vec
4660 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4663 c write (2,*) 'ungrad',ungrad
4666 C-----------------------------------------------------------------------------
4667 subroutine escp_soft_sphere(evdw2,evdw2_14)
4669 C This subroutine calculates the excluded-volume interaction energy between
4670 C peptide-group centers and side chains and its gradient in virtual-bond and
4671 C side-chain vectors.
4673 implicit real*8 (a-h,o-z)
4674 include 'DIMENSIONS'
4675 include 'COMMON.GEO'
4676 include 'COMMON.VAR'
4677 include 'COMMON.LOCAL'
4678 include 'COMMON.CHAIN'
4679 include 'COMMON.DERIV'
4680 include 'COMMON.INTERACT'
4681 include 'COMMON.FFIELD'
4682 include 'COMMON.IOUNITS'
4683 include 'COMMON.CONTROL'
4688 cd print '(a)','Enter ESCP'
4689 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4693 do i=iatscp_s,iatscp_e
4694 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4696 xi=0.5D0*(c(1,i)+c(1,i+1))
4697 yi=0.5D0*(c(2,i)+c(2,i+1))
4698 zi=0.5D0*(c(3,i)+c(3,i+1))
4699 C Return atom into box, boxxsize is size of box in x dimension
4701 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4702 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4703 C Condition for being inside the proper box
4704 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4705 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4709 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4710 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4711 C Condition for being inside the proper box
4712 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4713 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4717 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4718 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4719 cC Condition for being inside the proper box
4720 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4721 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4725 if (xi.lt.0) xi=xi+boxxsize
4727 if (yi.lt.0) yi=yi+boxysize
4729 if (zi.lt.0) zi=zi+boxzsize
4730 C xi=xi+xshift*boxxsize
4731 C yi=yi+yshift*boxysize
4732 C zi=zi+zshift*boxzsize
4733 do iint=1,nscp_gr(i)
4735 do j=iscpstart(i,iint),iscpend(i,iint)
4736 if (itype(j).eq.ntyp1) cycle
4737 itypj=iabs(itype(j))
4738 C Uncomment following three lines for SC-p interactions
4742 C Uncomment following three lines for Ca-p interactions
4747 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4748 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4749 C Condition for being inside the proper box
4750 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4751 c & (xj.lt.((-0.5d0)*boxxsize))) then
4755 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4756 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4757 cC Condition for being inside the proper box
4758 c if ((yj.gt.((0.5d0)*boxysize)).or.
4759 c & (yj.lt.((-0.5d0)*boxysize))) then
4763 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4764 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4765 C Condition for being inside the proper box
4766 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4767 c & (zj.lt.((-0.5d0)*boxzsize))) then
4770 if (xj.lt.0) xj=xj+boxxsize
4772 if (yj.lt.0) yj=yj+boxysize
4774 if (zj.lt.0) zj=zj+boxzsize
4775 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4783 xj=xj_safe+xshift*boxxsize
4784 yj=yj_safe+yshift*boxysize
4785 zj=zj_safe+zshift*boxzsize
4786 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4787 if(dist_temp.lt.dist_init) then
4797 if (subchap.eq.1) then
4810 rij=xj*xj+yj*yj+zj*zj
4814 if (rij.lt.r0ijsq) then
4815 evdwij=0.25d0*(rij-r0ijsq)**2
4823 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4828 cgrad if (j.lt.i) then
4829 cd write (iout,*) 'j<i'
4830 C Uncomment following three lines for SC-p interactions
4832 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4835 cd write (iout,*) 'j>i'
4837 cgrad ggg(k)=-ggg(k)
4838 C Uncomment following line for SC-p interactions
4839 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4843 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4845 cgrad kstart=min0(i+1,j)
4846 cgrad kend=max0(i-1,j-1)
4847 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4848 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4849 cgrad do k=kstart,kend
4851 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4855 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4856 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4867 C-----------------------------------------------------------------------------
4868 subroutine escp(evdw2,evdw2_14)
4870 C This subroutine calculates the excluded-volume interaction energy between
4871 C peptide-group centers and side chains and its gradient in virtual-bond and
4872 C side-chain vectors.
4874 implicit real*8 (a-h,o-z)
4875 include 'DIMENSIONS'
4876 include 'COMMON.GEO'
4877 include 'COMMON.VAR'
4878 include 'COMMON.LOCAL'
4879 include 'COMMON.CHAIN'
4880 include 'COMMON.DERIV'
4881 include 'COMMON.INTERACT'
4882 include 'COMMON.FFIELD'
4883 include 'COMMON.IOUNITS'
4884 include 'COMMON.CONTROL'
4885 include 'COMMON.SPLITELE'
4889 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
4890 cd print '(a)','Enter ESCP'
4891 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4895 do i=iatscp_s,iatscp_e
4896 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4898 xi=0.5D0*(c(1,i)+c(1,i+1))
4899 yi=0.5D0*(c(2,i)+c(2,i+1))
4900 zi=0.5D0*(c(3,i)+c(3,i+1))
4902 if (xi.lt.0) xi=xi+boxxsize
4904 if (yi.lt.0) yi=yi+boxysize
4906 if (zi.lt.0) zi=zi+boxzsize
4907 c xi=xi+xshift*boxxsize
4908 c yi=yi+yshift*boxysize
4909 c zi=zi+zshift*boxzsize
4910 c print *,xi,yi,zi,'polozenie i'
4911 C Return atom into box, boxxsize is size of box in x dimension
4913 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4914 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4915 C Condition for being inside the proper box
4916 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4917 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4921 c print *,xi,boxxsize,"pierwszy"
4923 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4924 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4925 C Condition for being inside the proper box
4926 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4927 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4931 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4932 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4933 C Condition for being inside the proper box
4934 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4935 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4938 do iint=1,nscp_gr(i)
4940 do j=iscpstart(i,iint),iscpend(i,iint)
4941 itypj=iabs(itype(j))
4942 if (itypj.eq.ntyp1) cycle
4943 C Uncomment following three lines for SC-p interactions
4947 C Uncomment following three lines for Ca-p interactions
4952 if (xj.lt.0) xj=xj+boxxsize
4954 if (yj.lt.0) yj=yj+boxysize
4956 if (zj.lt.0) zj=zj+boxzsize
4958 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4959 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4960 C Condition for being inside the proper box
4961 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4962 c & (xj.lt.((-0.5d0)*boxxsize))) then
4966 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4967 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4968 cC Condition for being inside the proper box
4969 c if ((yj.gt.((0.5d0)*boxysize)).or.
4970 c & (yj.lt.((-0.5d0)*boxysize))) then
4974 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4975 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4976 C Condition for being inside the proper box
4977 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4978 c & (zj.lt.((-0.5d0)*boxzsize))) then
4981 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
4982 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4990 xj=xj_safe+xshift*boxxsize
4991 yj=yj_safe+yshift*boxysize
4992 zj=zj_safe+zshift*boxzsize
4993 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4994 if(dist_temp.lt.dist_init) then
5004 if (subchap.eq.1) then
5013 c print *,xj,yj,zj,'polozenie j'
5014 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5016 sss=sscale(1.0d0/(dsqrt(rrij)))
5017 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
5018 c if (sss.eq.0) print *,'czasem jest OK'
5019 if (sss.le.0.0d0) cycle
5020 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5022 e1=fac*fac*aad(itypj,iteli)
5023 e2=fac*bad(itypj,iteli)
5024 if (iabs(j-i) .le. 2) then
5027 evdw2_14=evdw2_14+(e1+e2)*sss
5030 evdw2=evdw2+evdwij*sss
5031 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5032 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
5035 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5037 fac=-(evdwij+e1)*rrij*sss
5038 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5042 cgrad if (j.lt.i) then
5043 cd write (iout,*) 'j<i'
5044 C Uncomment following three lines for SC-p interactions
5046 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5049 cd write (iout,*) 'j>i'
5051 cgrad ggg(k)=-ggg(k)
5052 C Uncomment following line for SC-p interactions
5053 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5054 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5058 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5060 cgrad kstart=min0(i+1,j)
5061 cgrad kend=max0(i-1,j-1)
5062 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5063 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5064 cgrad do k=kstart,kend
5066 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5070 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5071 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5073 c endif !endif for sscale cutoff
5083 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5084 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5085 gradx_scp(j,i)=expon*gradx_scp(j,i)
5088 C******************************************************************************
5092 C To save time the factor EXPON has been extracted from ALL components
5093 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5096 C******************************************************************************
5099 C--------------------------------------------------------------------------
5100 subroutine edis(ehpb)
5102 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5104 implicit real*8 (a-h,o-z)
5105 include 'DIMENSIONS'
5106 include 'COMMON.SBRIDGE'
5107 include 'COMMON.CHAIN'
5108 include 'COMMON.DERIV'
5109 include 'COMMON.VAR'
5110 include 'COMMON.INTERACT'
5111 include 'COMMON.IOUNITS'
5114 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5115 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
5116 if (link_end.eq.0) return
5117 do i=link_start,link_end
5118 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5119 C CA-CA distance used in regularization of structure.
5122 C iii and jjj point to the residues for which the distance is assigned.
5123 if (ii.gt.nres) then
5130 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5131 c & dhpb(i),dhpb1(i),forcon(i)
5132 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5133 C distance and angle dependent SS bond potential.
5134 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5135 C & iabs(itype(jjj)).eq.1) then
5136 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5137 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5138 if (.not.dyn_ss .and. i.le.nss) then
5139 C 15/02/13 CC dynamic SSbond - additional check
5141 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5142 call ssbond_ene(iii,jjj,eij)
5145 cd write (iout,*) "eij",eij
5147 C Calculate the distance between the two points and its difference from the
5151 C Get the force constant corresponding to this distance.
5153 C Calculate the contribution to energy.
5154 ehpb=ehpb+waga*rdis*rdis
5156 C Evaluate gradient.
5159 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
5160 cd & ' waga=',waga,' fac=',fac
5162 ggg(j)=fac*(c(j,jj)-c(j,ii))
5164 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5165 C If this is a SC-SC distance, we need to calculate the contributions to the
5166 C Cartesian gradient in the SC vectors (ghpbx).
5169 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5170 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5173 cgrad do j=iii,jjj-1
5175 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5179 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5180 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5187 C--------------------------------------------------------------------------
5188 subroutine ssbond_ene(i,j,eij)
5190 C Calculate the distance and angle dependent SS-bond potential energy
5191 C using a free-energy function derived based on RHF/6-31G** ab initio
5192 C calculations of diethyl disulfide.
5194 C A. Liwo and U. Kozlowska, 11/24/03
5196 implicit real*8 (a-h,o-z)
5197 include 'DIMENSIONS'
5198 include 'COMMON.SBRIDGE'
5199 include 'COMMON.CHAIN'
5200 include 'COMMON.DERIV'
5201 include 'COMMON.LOCAL'
5202 include 'COMMON.INTERACT'
5203 include 'COMMON.VAR'
5204 include 'COMMON.IOUNITS'
5205 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5206 itypi=iabs(itype(i))
5210 dxi=dc_norm(1,nres+i)
5211 dyi=dc_norm(2,nres+i)
5212 dzi=dc_norm(3,nres+i)
5213 c dsci_inv=dsc_inv(itypi)
5214 dsci_inv=vbld_inv(nres+i)
5215 itypj=iabs(itype(j))
5216 c dscj_inv=dsc_inv(itypj)
5217 dscj_inv=vbld_inv(nres+j)
5221 dxj=dc_norm(1,nres+j)
5222 dyj=dc_norm(2,nres+j)
5223 dzj=dc_norm(3,nres+j)
5224 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5229 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5230 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5231 om12=dxi*dxj+dyi*dyj+dzi*dzj
5233 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5234 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5240 deltat12=om2-om1+2.0d0
5242 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5243 & +akct*deltad*deltat12
5244 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5245 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5246 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5247 c & " deltat12",deltat12," eij",eij
5248 ed=2*akcm*deltad+akct*deltat12
5250 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5251 eom1=-2*akth*deltat1-pom1-om2*pom2
5252 eom2= 2*akth*deltat2+pom1-om1*pom2
5255 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5256 ghpbx(k,i)=ghpbx(k,i)-ggk
5257 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5258 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5259 ghpbx(k,j)=ghpbx(k,j)+ggk
5260 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5261 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5262 ghpbc(k,i)=ghpbc(k,i)-ggk
5263 ghpbc(k,j)=ghpbc(k,j)+ggk
5266 C Calculate the components of the gradient in DC and X
5270 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5275 C--------------------------------------------------------------------------
5276 subroutine ebond(estr)
5278 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5280 implicit real*8 (a-h,o-z)
5281 include 'DIMENSIONS'
5282 include 'COMMON.LOCAL'
5283 include 'COMMON.GEO'
5284 include 'COMMON.INTERACT'
5285 include 'COMMON.DERIV'
5286 include 'COMMON.VAR'
5287 include 'COMMON.CHAIN'
5288 include 'COMMON.IOUNITS'
5289 include 'COMMON.NAMES'
5290 include 'COMMON.FFIELD'
5291 include 'COMMON.CONTROL'
5292 include 'COMMON.SETUP'
5293 double precision u(3),ud(3)
5296 do i=ibondp_start,ibondp_end
5297 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5298 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5300 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5301 c & *dc(j,i-1)/vbld(i)
5303 c if (energy_dec) write(iout,*)
5304 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5306 C Checking if it involves dummy (NH3+ or COO-) group
5307 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5308 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5309 diff = vbld(i)-vbldpDUM
5311 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5312 diff = vbld(i)-vbldp0
5314 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5315 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5318 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5320 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5323 estr=0.5d0*AKP*estr+estr1
5325 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5327 do i=ibond_start,ibond_end
5329 if (iti.ne.10 .and. iti.ne.ntyp1) then
5332 diff=vbld(i+nres)-vbldsc0(1,iti)
5333 if (energy_dec) write (iout,*)
5334 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5335 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5336 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5338 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5342 diff=vbld(i+nres)-vbldsc0(j,iti)
5343 ud(j)=aksc(j,iti)*diff
5344 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5358 uprod2=uprod2*u(k)*u(k)
5362 usumsqder=usumsqder+ud(j)*uprod2
5364 estr=estr+uprod/usum
5366 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5374 C--------------------------------------------------------------------------
5375 subroutine ebend(etheta)
5377 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5378 C angles gamma and its derivatives in consecutive thetas and gammas.
5380 implicit real*8 (a-h,o-z)
5381 include 'DIMENSIONS'
5382 include 'COMMON.LOCAL'
5383 include 'COMMON.GEO'
5384 include 'COMMON.INTERACT'
5385 include 'COMMON.DERIV'
5386 include 'COMMON.VAR'
5387 include 'COMMON.CHAIN'
5388 include 'COMMON.IOUNITS'
5389 include 'COMMON.NAMES'
5390 include 'COMMON.FFIELD'
5391 include 'COMMON.CONTROL'
5392 common /calcthet/ term1,term2,termm,diffak,ratak,
5393 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5394 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5395 double precision y(2),z(2)
5397 c time11=dexp(-2*time)
5400 c write (*,'(a,i2)') 'EBEND ICG=',icg
5401 do i=ithet_start,ithet_end
5402 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5403 & .or.itype(i).eq.ntyp1) cycle
5404 C Zero the energy function and its derivative at 0 or pi.
5405 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5407 ichir1=isign(1,itype(i-2))
5408 ichir2=isign(1,itype(i))
5409 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5410 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5411 if (itype(i-1).eq.10) then
5412 itype1=isign(10,itype(i-2))
5413 ichir11=isign(1,itype(i-2))
5414 ichir12=isign(1,itype(i-2))
5415 itype2=isign(10,itype(i))
5416 ichir21=isign(1,itype(i))
5417 ichir22=isign(1,itype(i))
5420 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5423 if (phii.ne.phii) phii=150.0
5433 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5436 if (phii1.ne.phii1) phii1=150.0
5448 C Calculate the "mean" value of theta from the part of the distribution
5449 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5450 C In following comments this theta will be referred to as t_c.
5451 thet_pred_mean=0.0d0
5453 athetk=athet(k,it,ichir1,ichir2)
5454 bthetk=bthet(k,it,ichir1,ichir2)
5456 athetk=athet(k,itype1,ichir11,ichir12)
5457 bthetk=bthet(k,itype2,ichir21,ichir22)
5459 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5460 c write(iout,*) 'chuj tu', y(k),z(k)
5462 dthett=thet_pred_mean*ssd
5463 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5464 C Derivatives of the "mean" values in gamma1 and gamma2.
5465 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5466 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5467 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5468 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5470 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5471 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5472 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5473 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5475 if (theta(i).gt.pi-delta) then
5476 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5478 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5479 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5480 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5482 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5484 else if (theta(i).lt.delta) then
5485 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5486 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5487 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5489 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5490 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5493 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5496 etheta=etheta+ethetai
5497 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5498 & 'ebend',i,ethetai,theta(i),itype(i)
5499 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5500 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5501 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5503 C Ufff.... We've done all this!!!
5506 C---------------------------------------------------------------------------
5507 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5509 implicit real*8 (a-h,o-z)
5510 include 'DIMENSIONS'
5511 include 'COMMON.LOCAL'
5512 include 'COMMON.IOUNITS'
5513 common /calcthet/ term1,term2,termm,diffak,ratak,
5514 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5515 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5516 C Calculate the contributions to both Gaussian lobes.
5517 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5518 C The "polynomial part" of the "standard deviation" of this part of
5519 C the distributioni.
5520 ccc write (iout,*) thetai,thet_pred_mean
5523 sig=sig*thet_pred_mean+polthet(j,it)
5525 C Derivative of the "interior part" of the "standard deviation of the"
5526 C gamma-dependent Gaussian lobe in t_c.
5527 sigtc=3*polthet(3,it)
5529 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5532 C Set the parameters of both Gaussian lobes of the distribution.
5533 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5534 fac=sig*sig+sigc0(it)
5537 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5538 sigsqtc=-4.0D0*sigcsq*sigtc
5539 c print *,i,sig,sigtc,sigsqtc
5540 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5541 sigtc=-sigtc/(fac*fac)
5542 C Following variable is sigma(t_c)**(-2)
5543 sigcsq=sigcsq*sigcsq
5545 sig0inv=1.0D0/sig0i**2
5546 delthec=thetai-thet_pred_mean
5547 delthe0=thetai-theta0i
5548 term1=-0.5D0*sigcsq*delthec*delthec
5549 term2=-0.5D0*sig0inv*delthe0*delthe0
5550 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5551 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5552 C NaNs in taking the logarithm. We extract the largest exponent which is added
5553 C to the energy (this being the log of the distribution) at the end of energy
5554 C term evaluation for this virtual-bond angle.
5555 if (term1.gt.term2) then
5557 term2=dexp(term2-termm)
5561 term1=dexp(term1-termm)
5564 C The ratio between the gamma-independent and gamma-dependent lobes of
5565 C the distribution is a Gaussian function of thet_pred_mean too.
5566 diffak=gthet(2,it)-thet_pred_mean
5567 ratak=diffak/gthet(3,it)**2
5568 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5569 C Let's differentiate it in thet_pred_mean NOW.
5571 C Now put together the distribution terms to make complete distribution.
5572 termexp=term1+ak*term2
5573 termpre=sigc+ak*sig0i
5574 C Contribution of the bending energy from this theta is just the -log of
5575 C the sum of the contributions from the two lobes and the pre-exponential
5576 C factor. Simple enough, isn't it?
5577 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5578 C write (iout,*) 'termexp',termexp,termm,termpre,i
5579 C NOW the derivatives!!!
5580 C 6/6/97 Take into account the deformation.
5581 E_theta=(delthec*sigcsq*term1
5582 & +ak*delthe0*sig0inv*term2)/termexp
5583 E_tc=((sigtc+aktc*sig0i)/termpre
5584 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5585 & aktc*term2)/termexp)
5588 c-----------------------------------------------------------------------------
5589 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5590 implicit real*8 (a-h,o-z)
5591 include 'DIMENSIONS'
5592 include 'COMMON.LOCAL'
5593 include 'COMMON.IOUNITS'
5594 common /calcthet/ term1,term2,termm,diffak,ratak,
5595 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5596 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5597 delthec=thetai-thet_pred_mean
5598 delthe0=thetai-theta0i
5599 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5600 t3 = thetai-thet_pred_mean
5604 t14 = t12+t6*sigsqtc
5606 t21 = thetai-theta0i
5612 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5613 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5614 & *(-t12*t9-ak*sig0inv*t27)
5618 C--------------------------------------------------------------------------
5619 subroutine ebend(etheta)
5621 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5622 C angles gamma and its derivatives in consecutive thetas and gammas.
5623 C ab initio-derived potentials from
5624 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5626 implicit real*8 (a-h,o-z)
5627 include 'DIMENSIONS'
5628 include 'COMMON.LOCAL'
5629 include 'COMMON.GEO'
5630 include 'COMMON.INTERACT'
5631 include 'COMMON.DERIV'
5632 include 'COMMON.VAR'
5633 include 'COMMON.CHAIN'
5634 include 'COMMON.IOUNITS'
5635 include 'COMMON.NAMES'
5636 include 'COMMON.FFIELD'
5637 include 'COMMON.CONTROL'
5638 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5639 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5640 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5641 & sinph1ph2(maxdouble,maxdouble)
5642 logical lprn /.false./, lprn1 /.false./
5644 do i=ithet_start,ithet_end
5645 c print *,i,itype(i-1),itype(i),itype(i-2)
5646 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5647 & .or.itype(i).eq.ntyp1) cycle
5648 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
5650 if (iabs(itype(i+1)).eq.20) iblock=2
5651 if (iabs(itype(i+1)).ne.20) iblock=1
5655 theti2=0.5d0*theta(i)
5656 ityp2=ithetyp((itype(i-1)))
5658 coskt(k)=dcos(k*theti2)
5659 sinkt(k)=dsin(k*theti2)
5661 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5664 if (phii.ne.phii) phii=150.0
5668 ityp1=ithetyp((itype(i-2)))
5669 C propagation of chirality for glycine type
5671 cosph1(k)=dcos(k*phii)
5672 sinph1(k)=dsin(k*phii)
5682 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5685 if (phii1.ne.phii1) phii1=150.0
5690 ityp3=ithetyp((itype(i)))
5692 cosph2(k)=dcos(k*phii1)
5693 sinph2(k)=dsin(k*phii1)
5703 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5706 ccl=cosph1(l)*cosph2(k-l)
5707 ssl=sinph1(l)*sinph2(k-l)
5708 scl=sinph1(l)*cosph2(k-l)
5709 csl=cosph1(l)*sinph2(k-l)
5710 cosph1ph2(l,k)=ccl-ssl
5711 cosph1ph2(k,l)=ccl+ssl
5712 sinph1ph2(l,k)=scl+csl
5713 sinph1ph2(k,l)=scl-csl
5717 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5718 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5719 write (iout,*) "coskt and sinkt"
5721 write (iout,*) k,coskt(k),sinkt(k)
5725 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5726 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5729 & write (iout,*) "k",k,"
5730 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5731 & " ethetai",ethetai
5734 write (iout,*) "cosph and sinph"
5736 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5738 write (iout,*) "cosph1ph2 and sinph2ph2"
5741 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5742 & sinph1ph2(l,k),sinph1ph2(k,l)
5745 write(iout,*) "ethetai",ethetai
5749 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5750 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5751 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5752 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5753 ethetai=ethetai+sinkt(m)*aux
5754 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5755 dephii=dephii+k*sinkt(m)*(
5756 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5757 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5758 dephii1=dephii1+k*sinkt(m)*(
5759 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5760 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5762 & write (iout,*) "m",m," k",k," bbthet",
5763 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5764 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5765 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5766 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5770 & write(iout,*) "ethetai",ethetai
5774 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5775 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5776 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5777 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5778 ethetai=ethetai+sinkt(m)*aux
5779 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5780 dephii=dephii+l*sinkt(m)*(
5781 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5782 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5783 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5784 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5785 dephii1=dephii1+(k-l)*sinkt(m)*(
5786 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5787 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5788 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5789 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5791 write (iout,*) "m",m," k",k," l",l," ffthet",
5792 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5793 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5794 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5795 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5796 & " ethetai",ethetai
5797 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5798 & cosph1ph2(k,l)*sinkt(m),
5799 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5807 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5808 & i,theta(i)*rad2deg,phii*rad2deg,
5809 & phii1*rad2deg,ethetai
5811 etheta=etheta+ethetai
5812 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5813 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5814 gloc(nphi+i-2,icg)=wang*dethetai+gloc(nphi+i-2,icg)
5820 c-----------------------------------------------------------------------------
5821 subroutine esc(escloc)
5822 C Calculate the local energy of a side chain and its derivatives in the
5823 C corresponding virtual-bond valence angles THETA and the spherical angles
5825 implicit real*8 (a-h,o-z)
5826 include 'DIMENSIONS'
5827 include 'COMMON.GEO'
5828 include 'COMMON.LOCAL'
5829 include 'COMMON.VAR'
5830 include 'COMMON.INTERACT'
5831 include 'COMMON.DERIV'
5832 include 'COMMON.CHAIN'
5833 include 'COMMON.IOUNITS'
5834 include 'COMMON.NAMES'
5835 include 'COMMON.FFIELD'
5836 include 'COMMON.CONTROL'
5837 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5838 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5839 common /sccalc/ time11,time12,time112,theti,it,nlobit
5842 c write (iout,'(a)') 'ESC'
5843 do i=loc_start,loc_end
5845 if (it.eq.ntyp1) cycle
5846 if (it.eq.10) goto 1
5847 nlobit=nlob(iabs(it))
5848 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5849 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5850 theti=theta(i+1)-pipol
5855 if (x(2).gt.pi-delta) then
5859 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5861 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5862 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5864 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5865 & ddersc0(1),dersc(1))
5866 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5867 & ddersc0(3),dersc(3))
5869 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5871 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5872 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5873 & dersc0(2),esclocbi,dersc02)
5874 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5876 call splinthet(x(2),0.5d0*delta,ss,ssd)
5881 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5883 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5884 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5886 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5888 c write (iout,*) escloci
5889 else if (x(2).lt.delta) then
5893 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5895 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5896 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5898 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5899 & ddersc0(1),dersc(1))
5900 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5901 & ddersc0(3),dersc(3))
5903 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5905 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5906 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5907 & dersc0(2),esclocbi,dersc02)
5908 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5913 call splinthet(x(2),0.5d0*delta,ss,ssd)
5915 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5917 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5918 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5920 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5921 c write (iout,*) escloci
5923 call enesc(x,escloci,dersc,ddummy,.false.)
5926 escloc=escloc+escloci
5927 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5928 & 'escloc',i,escloci
5929 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5931 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5933 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5934 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5939 C---------------------------------------------------------------------------
5940 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5941 implicit real*8 (a-h,o-z)
5942 include 'DIMENSIONS'
5943 include 'COMMON.GEO'
5944 include 'COMMON.LOCAL'
5945 include 'COMMON.IOUNITS'
5946 common /sccalc/ time11,time12,time112,theti,it,nlobit
5947 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5948 double precision contr(maxlob,-1:1)
5950 c write (iout,*) 'it=',it,' nlobit=',nlobit
5954 if (mixed) ddersc(j)=0.0d0
5958 C Because of periodicity of the dependence of the SC energy in omega we have
5959 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5960 C To avoid underflows, first compute & store the exponents.
5968 z(k)=x(k)-censc(k,j,it)
5973 Axk=Axk+gaussc(l,k,j,it)*z(l)
5979 expfac=expfac+Ax(k,j,iii)*z(k)
5987 C As in the case of ebend, we want to avoid underflows in exponentiation and
5988 C subsequent NaNs and INFs in energy calculation.
5989 C Find the largest exponent
5993 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5997 cd print *,'it=',it,' emin=',emin
5999 C Compute the contribution to SC energy and derivatives
6004 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6005 if(adexp.ne.adexp) adexp=1.0
6008 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6010 cd print *,'j=',j,' expfac=',expfac
6011 escloc_i=escloc_i+expfac
6013 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6017 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6018 & +gaussc(k,2,j,it))*expfac
6025 dersc(1)=dersc(1)/cos(theti)**2
6026 ddersc(1)=ddersc(1)/cos(theti)**2
6029 escloci=-(dlog(escloc_i)-emin)
6031 dersc(j)=dersc(j)/escloc_i
6035 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6040 C------------------------------------------------------------------------------
6041 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6042 implicit real*8 (a-h,o-z)
6043 include 'DIMENSIONS'
6044 include 'COMMON.GEO'
6045 include 'COMMON.LOCAL'
6046 include 'COMMON.IOUNITS'
6047 common /sccalc/ time11,time12,time112,theti,it,nlobit
6048 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6049 double precision contr(maxlob)
6060 z(k)=x(k)-censc(k,j,it)
6066 Axk=Axk+gaussc(l,k,j,it)*z(l)
6072 expfac=expfac+Ax(k,j)*z(k)
6077 C As in the case of ebend, we want to avoid underflows in exponentiation and
6078 C subsequent NaNs and INFs in energy calculation.
6079 C Find the largest exponent
6082 if (emin.gt.contr(j)) emin=contr(j)
6086 C Compute the contribution to SC energy and derivatives
6090 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6091 escloc_i=escloc_i+expfac
6093 dersc(k)=dersc(k)+Ax(k,j)*expfac
6095 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6096 & +gaussc(1,2,j,it))*expfac
6100 dersc(1)=dersc(1)/cos(theti)**2
6101 dersc12=dersc12/cos(theti)**2
6102 escloci=-(dlog(escloc_i)-emin)
6104 dersc(j)=dersc(j)/escloc_i
6106 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6110 c----------------------------------------------------------------------------------
6111 subroutine esc(escloc)
6112 C Calculate the local energy of a side chain and its derivatives in the
6113 C corresponding virtual-bond valence angles THETA and the spherical angles
6114 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6115 C added by Urszula Kozlowska. 07/11/2007
6117 implicit real*8 (a-h,o-z)
6118 include 'DIMENSIONS'
6119 include 'COMMON.GEO'
6120 include 'COMMON.LOCAL'
6121 include 'COMMON.VAR'
6122 include 'COMMON.SCROT'
6123 include 'COMMON.INTERACT'
6124 include 'COMMON.DERIV'
6125 include 'COMMON.CHAIN'
6126 include 'COMMON.IOUNITS'
6127 include 'COMMON.NAMES'
6128 include 'COMMON.FFIELD'
6129 include 'COMMON.CONTROL'
6130 include 'COMMON.VECTORS'
6131 double precision x_prime(3),y_prime(3),z_prime(3)
6132 & , sumene,dsc_i,dp2_i,x(65),
6133 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6134 & de_dxx,de_dyy,de_dzz,de_dt
6135 double precision s1_t,s1_6_t,s2_t,s2_6_t
6137 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6138 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6139 & dt_dCi(3),dt_dCi1(3)
6140 common /sccalc/ time11,time12,time112,theti,it,nlobit
6143 do i=loc_start,loc_end
6144 if (itype(i).eq.ntyp1) cycle
6145 costtab(i+1) =dcos(theta(i+1))
6146 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6147 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6148 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6149 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6150 cosfac=dsqrt(cosfac2)
6151 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6152 sinfac=dsqrt(sinfac2)
6154 if (it.eq.10) goto 1
6156 C Compute the axes of tghe local cartesian coordinates system; store in
6157 c x_prime, y_prime and z_prime
6164 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6165 C & dc_norm(3,i+nres)
6167 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6168 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6171 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6174 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6175 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6176 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6177 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6178 c & " xy",scalar(x_prime(1),y_prime(1)),
6179 c & " xz",scalar(x_prime(1),z_prime(1)),
6180 c & " yy",scalar(y_prime(1),y_prime(1)),
6181 c & " yz",scalar(y_prime(1),z_prime(1)),
6182 c & " zz",scalar(z_prime(1),z_prime(1))
6184 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6185 C to local coordinate system. Store in xx, yy, zz.
6191 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6192 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6193 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6200 C Compute the energy of the ith side cbain
6202 c write (2,*) "xx",xx," yy",yy," zz",zz
6205 x(j) = sc_parmin(j,it)
6208 Cc diagnostics - remove later
6210 yy1 = dsin(alph(2))*dcos(omeg(2))
6211 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
6212 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6213 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6215 C," --- ", xx_w,yy_w,zz_w
6218 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6219 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6221 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6222 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6224 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6225 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6226 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6227 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6228 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6230 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6231 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6232 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6233 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6234 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6236 dsc_i = 0.743d0+x(61)
6238 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6239 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6240 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6241 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6242 s1=(1+x(63))/(0.1d0 + dscp1)
6243 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6244 s2=(1+x(65))/(0.1d0 + dscp2)
6245 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6246 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6247 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6248 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6250 c & dscp1,dscp2,sumene
6251 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6252 escloc = escloc + sumene
6253 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6258 C This section to check the numerical derivatives of the energy of ith side
6259 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6260 C #define DEBUG in the code to turn it on.
6262 write (2,*) "sumene =",sumene
6266 write (2,*) xx,yy,zz
6267 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6268 de_dxx_num=(sumenep-sumene)/aincr
6270 write (2,*) "xx+ sumene from enesc=",sumenep
6273 write (2,*) xx,yy,zz
6274 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6275 de_dyy_num=(sumenep-sumene)/aincr
6277 write (2,*) "yy+ sumene from enesc=",sumenep
6280 write (2,*) xx,yy,zz
6281 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6282 de_dzz_num=(sumenep-sumene)/aincr
6284 write (2,*) "zz+ sumene from enesc=",sumenep
6285 costsave=cost2tab(i+1)
6286 sintsave=sint2tab(i+1)
6287 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6288 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6289 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6290 de_dt_num=(sumenep-sumene)/aincr
6291 write (2,*) " t+ sumene from enesc=",sumenep
6292 cost2tab(i+1)=costsave
6293 sint2tab(i+1)=sintsave
6294 C End of diagnostics section.
6297 C Compute the gradient of esc
6299 c zz=zz*dsign(1.0,dfloat(itype(i)))
6300 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6301 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6302 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6303 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6304 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6305 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6306 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6307 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6308 pom1=(sumene3*sint2tab(i+1)+sumene1)
6309 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6310 pom2=(sumene4*cost2tab(i+1)+sumene2)
6311 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6312 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6313 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6314 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6316 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6317 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6318 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6320 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6321 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6322 & +(pom1+pom2)*pom_dx
6324 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6327 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6328 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6329 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6331 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6332 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6333 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6334 & +x(59)*zz**2 +x(60)*xx*zz
6335 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6336 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6337 & +(pom1-pom2)*pom_dy
6339 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6342 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6343 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6344 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6345 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6346 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6347 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6348 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6349 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6351 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6354 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6355 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6356 & +pom1*pom_dt1+pom2*pom_dt2
6358 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6363 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6364 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6365 cosfac2xx=cosfac2*xx
6366 sinfac2yy=sinfac2*yy
6368 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6370 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6372 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6373 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6374 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6375 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6376 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6377 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6378 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6379 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6380 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6381 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6385 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6386 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6387 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6388 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6391 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6392 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6393 dZZ_XYZ(k)=vbld_inv(i+nres)*
6394 & (z_prime(k)-zz*dC_norm(k,i+nres))
6396 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6397 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6401 dXX_Ctab(k,i)=dXX_Ci(k)
6402 dXX_C1tab(k,i)=dXX_Ci1(k)
6403 dYY_Ctab(k,i)=dYY_Ci(k)
6404 dYY_C1tab(k,i)=dYY_Ci1(k)
6405 dZZ_Ctab(k,i)=dZZ_Ci(k)
6406 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6407 dXX_XYZtab(k,i)=dXX_XYZ(k)
6408 dYY_XYZtab(k,i)=dYY_XYZ(k)
6409 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6413 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6414 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6415 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6416 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6417 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6419 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6420 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6421 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6422 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6423 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6424 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6425 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6426 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6428 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6429 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6431 C to check gradient call subroutine check_grad
6437 c------------------------------------------------------------------------------
6438 double precision function enesc(x,xx,yy,zz,cost2,sint2)
6440 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
6441 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6442 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6443 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6445 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6446 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6448 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6449 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6450 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6451 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6452 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6454 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6455 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6456 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6457 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6458 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6460 dsc_i = 0.743d0+x(61)
6462 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6463 & *(xx*cost2+yy*sint2))
6464 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6465 & *(xx*cost2-yy*sint2))
6466 s1=(1+x(63))/(0.1d0 + dscp1)
6467 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6468 s2=(1+x(65))/(0.1d0 + dscp2)
6469 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6470 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
6471 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
6476 c------------------------------------------------------------------------------
6477 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6479 C This procedure calculates two-body contact function g(rij) and its derivative:
6482 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6485 C where x=(rij-r0ij)/delta
6487 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6490 double precision rij,r0ij,eps0ij,fcont,fprimcont
6491 double precision x,x2,x4,delta
6495 if (x.lt.-1.0D0) then
6498 else if (x.le.1.0D0) then
6501 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6502 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6509 c------------------------------------------------------------------------------
6510 subroutine splinthet(theti,delta,ss,ssder)
6511 implicit real*8 (a-h,o-z)
6512 include 'DIMENSIONS'
6513 include 'COMMON.VAR'
6514 include 'COMMON.GEO'
6517 if (theti.gt.pipol) then
6518 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6520 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6525 c------------------------------------------------------------------------------
6526 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6528 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6529 double precision ksi,ksi2,ksi3,a1,a2,a3
6530 a1=fprim0*delta/(f1-f0)
6536 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6537 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6540 c------------------------------------------------------------------------------
6541 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6543 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6544 double precision ksi,ksi2,ksi3,a1,a2,a3
6549 a2=3*(f1x-f0x)-2*fprim0x*delta
6550 a3=fprim0x*delta-2*(f1x-f0x)
6551 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6554 C-----------------------------------------------------------------------------
6556 C-----------------------------------------------------------------------------
6557 subroutine etor(etors,edihcnstr)
6558 implicit real*8 (a-h,o-z)
6559 include 'DIMENSIONS'
6560 include 'COMMON.VAR'
6561 include 'COMMON.GEO'
6562 include 'COMMON.LOCAL'
6563 include 'COMMON.TORSION'
6564 include 'COMMON.INTERACT'
6565 include 'COMMON.DERIV'
6566 include 'COMMON.CHAIN'
6567 include 'COMMON.NAMES'
6568 include 'COMMON.IOUNITS'
6569 include 'COMMON.FFIELD'
6570 include 'COMMON.TORCNSTR'
6571 include 'COMMON.CONTROL'
6573 C Set lprn=.true. for debugging
6577 do i=iphi_start,iphi_end
6579 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6580 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6581 itori=itortyp(itype(i-2))
6582 itori1=itortyp(itype(i-1))
6585 C Proline-Proline pair is a special case...
6586 if (itori.eq.3 .and. itori1.eq.3) then
6587 if (phii.gt.-dwapi3) then
6589 fac=1.0D0/(1.0D0-cosphi)
6590 etorsi=v1(1,3,3)*fac
6591 etorsi=etorsi+etorsi
6592 etors=etors+etorsi-v1(1,3,3)
6593 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6594 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6597 v1ij=v1(j+1,itori,itori1)
6598 v2ij=v2(j+1,itori,itori1)
6601 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6602 if (energy_dec) etors_ii=etors_ii+
6603 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6604 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6608 v1ij=v1(j,itori,itori1)
6609 v2ij=v2(j,itori,itori1)
6612 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6613 if (energy_dec) etors_ii=etors_ii+
6614 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6615 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6618 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6621 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6622 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6623 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6624 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6625 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6627 ! 6/20/98 - dihedral angle constraints
6630 itori=idih_constr(i)
6633 if (difi.gt.drange(i)) then
6635 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6636 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6637 else if (difi.lt.-drange(i)) then
6639 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6640 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6642 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6643 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6645 ! write (iout,*) 'edihcnstr',edihcnstr
6648 c------------------------------------------------------------------------------
6649 subroutine etor_d(etors_d)
6653 c----------------------------------------------------------------------------
6655 subroutine etor(etors,edihcnstr)
6656 implicit real*8 (a-h,o-z)
6657 include 'DIMENSIONS'
6658 include 'COMMON.VAR'
6659 include 'COMMON.GEO'
6660 include 'COMMON.LOCAL'
6661 include 'COMMON.TORSION'
6662 include 'COMMON.INTERACT'
6663 include 'COMMON.DERIV'
6664 include 'COMMON.CHAIN'
6665 include 'COMMON.NAMES'
6666 include 'COMMON.IOUNITS'
6667 include 'COMMON.FFIELD'
6668 include 'COMMON.TORCNSTR'
6669 include 'COMMON.CONTROL'
6671 C Set lprn=.true. for debugging
6675 do i=iphi_start,iphi_end
6676 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6677 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6678 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6679 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6680 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6681 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6682 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6683 C For introducing the NH3+ and COO- group please check the etor_d for reference
6686 if (iabs(itype(i)).eq.20) then
6691 itori=itortyp(itype(i-2))
6692 itori1=itortyp(itype(i-1))
6695 C Regular cosine and sine terms
6696 do j=1,nterm(itori,itori1,iblock)
6697 v1ij=v1(j,itori,itori1,iblock)
6698 v2ij=v2(j,itori,itori1,iblock)
6701 etors=etors+v1ij*cosphi+v2ij*sinphi
6702 if (energy_dec) etors_ii=etors_ii+
6703 & v1ij*cosphi+v2ij*sinphi
6704 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6708 C E = SUM ----------------------------------- - v1
6709 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6711 cosphi=dcos(0.5d0*phii)
6712 sinphi=dsin(0.5d0*phii)
6713 do j=1,nlor(itori,itori1,iblock)
6714 vl1ij=vlor1(j,itori,itori1)
6715 vl2ij=vlor2(j,itori,itori1)
6716 vl3ij=vlor3(j,itori,itori1)
6717 pom=vl2ij*cosphi+vl3ij*sinphi
6718 pom1=1.0d0/(pom*pom+1.0d0)
6719 etors=etors+vl1ij*pom1
6720 if (energy_dec) etors_ii=etors_ii+
6723 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6725 C Subtract the constant term
6726 etors=etors-v0(itori,itori1,iblock)
6727 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6728 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6730 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6731 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6732 & (v1(j,itori,itori1,iblock),j=1,6),
6733 & (v2(j,itori,itori1,iblock),j=1,6)
6734 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6735 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6737 ! 6/20/98 - dihedral angle constraints
6739 c do i=1,ndih_constr
6740 do i=idihconstr_start,idihconstr_end
6741 itori=idih_constr(i)
6743 difi=pinorm(phii-phi0(i))
6744 if (difi.gt.drange(i)) then
6746 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6747 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6748 else if (difi.lt.-drange(i)) then
6750 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6751 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6755 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6756 cd & rad2deg*phi0(i), rad2deg*drange(i),
6757 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6759 cd write (iout,*) 'edihcnstr',edihcnstr
6762 c----------------------------------------------------------------------------
6763 subroutine etor_d(etors_d)
6764 C 6/23/01 Compute double torsional energy
6765 implicit real*8 (a-h,o-z)
6766 include 'DIMENSIONS'
6767 include 'COMMON.VAR'
6768 include 'COMMON.GEO'
6769 include 'COMMON.LOCAL'
6770 include 'COMMON.TORSION'
6771 include 'COMMON.INTERACT'
6772 include 'COMMON.DERIV'
6773 include 'COMMON.CHAIN'
6774 include 'COMMON.NAMES'
6775 include 'COMMON.IOUNITS'
6776 include 'COMMON.FFIELD'
6777 include 'COMMON.TORCNSTR'
6779 C Set lprn=.true. for debugging
6783 c write(iout,*) "a tu??"
6784 do i=iphid_start,iphid_end
6785 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6786 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6787 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6788 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6789 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6790 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6791 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6792 & (itype(i+1).eq.ntyp1)) cycle
6793 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6794 itori=itortyp(itype(i-2))
6795 itori1=itortyp(itype(i-1))
6796 itori2=itortyp(itype(i))
6802 if (iabs(itype(i+1)).eq.20) iblock=2
6803 C Iblock=2 Proline type
6804 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6805 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6806 C if (itype(i+1).eq.ntyp1) iblock=3
6807 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6808 C IS or IS NOT need for this
6809 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6810 C is (itype(i-3).eq.ntyp1) ntblock=2
6811 C ntblock is N-terminal blocking group
6813 C Regular cosine and sine terms
6814 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6815 C Example of changes for NH3+ blocking group
6816 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6817 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6818 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6819 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6820 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6821 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6822 cosphi1=dcos(j*phii)
6823 sinphi1=dsin(j*phii)
6824 cosphi2=dcos(j*phii1)
6825 sinphi2=dsin(j*phii1)
6826 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6827 & v2cij*cosphi2+v2sij*sinphi2
6828 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6829 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6831 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6833 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6834 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6835 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6836 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6837 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6838 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6839 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6840 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6841 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6842 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6843 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6844 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6845 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6846 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6849 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6850 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6855 c------------------------------------------------------------------------------
6856 subroutine eback_sc_corr(esccor)
6857 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6858 c conformational states; temporarily implemented as differences
6859 c between UNRES torsional potentials (dependent on three types of
6860 c residues) and the torsional potentials dependent on all 20 types
6861 c of residues computed from AM1 energy surfaces of terminally-blocked
6862 c amino-acid residues.
6863 implicit real*8 (a-h,o-z)
6864 include 'DIMENSIONS'
6865 include 'COMMON.VAR'
6866 include 'COMMON.GEO'
6867 include 'COMMON.LOCAL'
6868 include 'COMMON.TORSION'
6869 include 'COMMON.SCCOR'
6870 include 'COMMON.INTERACT'
6871 include 'COMMON.DERIV'
6872 include 'COMMON.CHAIN'
6873 include 'COMMON.NAMES'
6874 include 'COMMON.IOUNITS'
6875 include 'COMMON.FFIELD'
6876 include 'COMMON.CONTROL'
6878 C Set lprn=.true. for debugging
6881 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6883 do i=itau_start,itau_end
6884 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6886 isccori=isccortyp(itype(i-2))
6887 isccori1=isccortyp(itype(i-1))
6888 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6890 do intertyp=1,3 !intertyp
6891 cc Added 09 May 2012 (Adasko)
6892 cc Intertyp means interaction type of backbone mainchain correlation:
6893 c 1 = SC...Ca...Ca...Ca
6894 c 2 = Ca...Ca...Ca...SC
6895 c 3 = SC...Ca...Ca...SCi
6897 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6898 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6899 & (itype(i-1).eq.ntyp1)))
6900 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6901 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6902 & .or.(itype(i).eq.ntyp1)))
6903 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6904 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6905 & (itype(i-3).eq.ntyp1)))) cycle
6906 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6907 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6909 do j=1,nterm_sccor(isccori,isccori1)
6910 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6911 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6912 cosphi=dcos(j*tauangle(intertyp,i))
6913 sinphi=dsin(j*tauangle(intertyp,i))
6914 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6915 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6917 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6918 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6920 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6921 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6922 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6923 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6924 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6930 c----------------------------------------------------------------------------
6931 subroutine multibody(ecorr)
6932 C This subroutine calculates multi-body contributions to energy following
6933 C the idea of Skolnick et al. If side chains I and J make a contact and
6934 C at the same time side chains I+1 and J+1 make a contact, an extra
6935 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6936 implicit real*8 (a-h,o-z)
6937 include 'DIMENSIONS'
6938 include 'COMMON.IOUNITS'
6939 include 'COMMON.DERIV'
6940 include 'COMMON.INTERACT'
6941 include 'COMMON.CONTACTS'
6942 double precision gx(3),gx1(3)
6945 C Set lprn=.true. for debugging
6949 write (iout,'(a)') 'Contact function values:'
6951 write (iout,'(i2,20(1x,i2,f10.5))')
6952 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6967 num_conti=num_cont(i)
6968 num_conti1=num_cont(i1)
6973 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6974 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6975 cd & ' ishift=',ishift
6976 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6977 C The system gains extra energy.
6978 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6979 endif ! j1==j+-ishift
6988 c------------------------------------------------------------------------------
6989 double precision function esccorr(i,j,k,l,jj,kk)
6990 implicit real*8 (a-h,o-z)
6991 include 'DIMENSIONS'
6992 include 'COMMON.IOUNITS'
6993 include 'COMMON.DERIV'
6994 include 'COMMON.INTERACT'
6995 include 'COMMON.CONTACTS'
6996 double precision gx(3),gx1(3)
7001 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7002 C Calculate the multi-body contribution to energy.
7003 C Calculate multi-body contributions to the gradient.
7004 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7005 cd & k,l,(gacont(m,kk,k),m=1,3)
7007 gx(m) =ekl*gacont(m,jj,i)
7008 gx1(m)=eij*gacont(m,kk,k)
7009 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7010 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7011 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7012 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7016 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7021 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7027 c------------------------------------------------------------------------------
7028 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7029 C This subroutine calculates multi-body contributions to hydrogen-bonding
7030 implicit real*8 (a-h,o-z)
7031 include 'DIMENSIONS'
7032 include 'COMMON.IOUNITS'
7035 parameter (max_cont=maxconts)
7036 parameter (max_dim=26)
7037 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7038 double precision zapas(max_dim,maxconts,max_fg_procs),
7039 & zapas_recv(max_dim,maxconts,max_fg_procs)
7040 common /przechowalnia/ zapas
7041 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7042 & status_array(MPI_STATUS_SIZE,maxconts*2)
7044 include 'COMMON.SETUP'
7045 include 'COMMON.FFIELD'
7046 include 'COMMON.DERIV'
7047 include 'COMMON.INTERACT'
7048 include 'COMMON.CONTACTS'
7049 include 'COMMON.CONTROL'
7050 include 'COMMON.LOCAL'
7051 double precision gx(3),gx1(3),time00
7054 C Set lprn=.true. for debugging
7059 if (nfgtasks.le.1) goto 30
7061 write (iout,'(a)') 'Contact function values before RECEIVE:'
7063 write (iout,'(2i3,50(1x,i2,f5.2))')
7064 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7065 & j=1,num_cont_hb(i))
7069 do i=1,ntask_cont_from
7072 do i=1,ntask_cont_to
7075 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7077 C Make the list of contacts to send to send to other procesors
7078 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7080 do i=iturn3_start,iturn3_end
7081 c write (iout,*) "make contact list turn3",i," num_cont",
7083 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7085 do i=iturn4_start,iturn4_end
7086 c write (iout,*) "make contact list turn4",i," num_cont",
7088 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7092 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7094 do j=1,num_cont_hb(i)
7097 iproc=iint_sent_local(k,jjc,ii)
7098 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7099 if (iproc.gt.0) then
7100 ncont_sent(iproc)=ncont_sent(iproc)+1
7101 nn=ncont_sent(iproc)
7103 zapas(2,nn,iproc)=jjc
7104 zapas(3,nn,iproc)=facont_hb(j,i)
7105 zapas(4,nn,iproc)=ees0p(j,i)
7106 zapas(5,nn,iproc)=ees0m(j,i)
7107 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7108 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7109 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7110 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7111 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7112 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7113 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7114 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7115 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7116 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7117 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7118 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7119 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7120 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7121 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7122 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7123 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7124 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7125 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7126 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7127 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7134 & "Numbers of contacts to be sent to other processors",
7135 & (ncont_sent(i),i=1,ntask_cont_to)
7136 write (iout,*) "Contacts sent"
7137 do ii=1,ntask_cont_to
7139 iproc=itask_cont_to(ii)
7140 write (iout,*) nn," contacts to processor",iproc,
7141 & " of CONT_TO_COMM group"
7143 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7151 CorrelID1=nfgtasks+fg_rank+1
7153 C Receive the numbers of needed contacts from other processors
7154 do ii=1,ntask_cont_from
7155 iproc=itask_cont_from(ii)
7157 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7158 & FG_COMM,req(ireq),IERR)
7160 c write (iout,*) "IRECV ended"
7162 C Send the number of contacts needed by other processors
7163 do ii=1,ntask_cont_to
7164 iproc=itask_cont_to(ii)
7166 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7167 & FG_COMM,req(ireq),IERR)
7169 c write (iout,*) "ISEND ended"
7170 c write (iout,*) "number of requests (nn)",ireq
7173 & call MPI_Waitall(ireq,req,status_array,ierr)
7175 c & "Numbers of contacts to be received from other processors",
7176 c & (ncont_recv(i),i=1,ntask_cont_from)
7180 do ii=1,ntask_cont_from
7181 iproc=itask_cont_from(ii)
7183 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7184 c & " of CONT_TO_COMM group"
7188 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7189 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7190 c write (iout,*) "ireq,req",ireq,req(ireq)
7193 C Send the contacts to processors that need them
7194 do ii=1,ntask_cont_to
7195 iproc=itask_cont_to(ii)
7197 c write (iout,*) nn," contacts to processor",iproc,
7198 c & " of CONT_TO_COMM group"
7201 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7202 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7203 c write (iout,*) "ireq,req",ireq,req(ireq)
7205 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7209 c write (iout,*) "number of requests (contacts)",ireq
7210 c write (iout,*) "req",(req(i),i=1,4)
7213 & call MPI_Waitall(ireq,req,status_array,ierr)
7214 do iii=1,ntask_cont_from
7215 iproc=itask_cont_from(iii)
7218 write (iout,*) "Received",nn," contacts from processor",iproc,
7219 & " of CONT_FROM_COMM group"
7222 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7227 ii=zapas_recv(1,i,iii)
7228 c Flag the received contacts to prevent double-counting
7229 jj=-zapas_recv(2,i,iii)
7230 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7232 nnn=num_cont_hb(ii)+1
7235 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7236 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7237 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7238 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7239 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7240 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7241 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7242 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7243 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7244 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7245 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7246 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7247 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7248 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7249 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7250 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7251 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7252 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7253 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7254 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7255 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7256 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7257 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7258 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7263 write (iout,'(a)') 'Contact function values after receive:'
7265 write (iout,'(2i3,50(1x,i3,f5.2))')
7266 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7267 & j=1,num_cont_hb(i))
7274 write (iout,'(a)') 'Contact function values:'
7276 write (iout,'(2i3,50(1x,i3,f5.2))')
7277 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7278 & j=1,num_cont_hb(i))
7282 C Remove the loop below after debugging !!!
7289 C Calculate the local-electrostatic correlation terms
7290 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7292 num_conti=num_cont_hb(i)
7293 num_conti1=num_cont_hb(i+1)
7300 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7301 c & ' jj=',jj,' kk=',kk
7302 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7303 & .or. j.lt.0 .and. j1.gt.0) .and.
7304 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7305 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7306 C The system gains extra energy.
7307 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7308 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7309 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7311 else if (j1.eq.j) then
7312 C Contacts I-J and I-(J+1) occur simultaneously.
7313 C The system loses extra energy.
7314 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7319 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7320 c & ' jj=',jj,' kk=',kk
7322 C Contacts I-J and (I+1)-J occur simultaneously.
7323 C The system loses extra energy.
7324 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7331 c------------------------------------------------------------------------------
7332 subroutine add_hb_contact(ii,jj,itask)
7333 implicit real*8 (a-h,o-z)
7334 include "DIMENSIONS"
7335 include "COMMON.IOUNITS"
7338 parameter (max_cont=maxconts)
7339 parameter (max_dim=26)
7340 include "COMMON.CONTACTS"
7341 double precision zapas(max_dim,maxconts,max_fg_procs),
7342 & zapas_recv(max_dim,maxconts,max_fg_procs)
7343 common /przechowalnia/ zapas
7344 integer i,j,ii,jj,iproc,itask(4),nn
7345 c write (iout,*) "itask",itask
7348 if (iproc.gt.0) then
7349 do j=1,num_cont_hb(ii)
7351 c write (iout,*) "i",ii," j",jj," jjc",jjc
7353 ncont_sent(iproc)=ncont_sent(iproc)+1
7354 nn=ncont_sent(iproc)
7355 zapas(1,nn,iproc)=ii
7356 zapas(2,nn,iproc)=jjc
7357 zapas(3,nn,iproc)=facont_hb(j,ii)
7358 zapas(4,nn,iproc)=ees0p(j,ii)
7359 zapas(5,nn,iproc)=ees0m(j,ii)
7360 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7361 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7362 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7363 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7364 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7365 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7366 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7367 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7368 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7369 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7370 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7371 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7372 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7373 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7374 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7375 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7376 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7377 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7378 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7379 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7380 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7388 c------------------------------------------------------------------------------
7389 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7391 C This subroutine calculates multi-body contributions to hydrogen-bonding
7392 implicit real*8 (a-h,o-z)
7393 include 'DIMENSIONS'
7394 include 'COMMON.IOUNITS'
7397 parameter (max_cont=maxconts)
7398 parameter (max_dim=70)
7399 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7400 double precision zapas(max_dim,maxconts,max_fg_procs),
7401 & zapas_recv(max_dim,maxconts,max_fg_procs)
7402 common /przechowalnia/ zapas
7403 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7404 & status_array(MPI_STATUS_SIZE,maxconts*2)
7406 include 'COMMON.SETUP'
7407 include 'COMMON.FFIELD'
7408 include 'COMMON.DERIV'
7409 include 'COMMON.LOCAL'
7410 include 'COMMON.INTERACT'
7411 include 'COMMON.CONTACTS'
7412 include 'COMMON.CHAIN'
7413 include 'COMMON.CONTROL'
7414 double precision gx(3),gx1(3)
7415 integer num_cont_hb_old(maxres)
7417 double precision eello4,eello5,eelo6,eello_turn6
7418 external eello4,eello5,eello6,eello_turn6
7419 C Set lprn=.true. for debugging
7424 num_cont_hb_old(i)=num_cont_hb(i)
7428 if (nfgtasks.le.1) goto 30
7430 write (iout,'(a)') 'Contact function values before RECEIVE:'
7432 write (iout,'(2i3,50(1x,i2,f5.2))')
7433 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7434 & j=1,num_cont_hb(i))
7438 do i=1,ntask_cont_from
7441 do i=1,ntask_cont_to
7444 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7446 C Make the list of contacts to send to send to other procesors
7447 do i=iturn3_start,iturn3_end
7448 c write (iout,*) "make contact list turn3",i," num_cont",
7450 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7452 do i=iturn4_start,iturn4_end
7453 c write (iout,*) "make contact list turn4",i," num_cont",
7455 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7459 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7461 do j=1,num_cont_hb(i)
7464 iproc=iint_sent_local(k,jjc,ii)
7465 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7466 if (iproc.ne.0) then
7467 ncont_sent(iproc)=ncont_sent(iproc)+1
7468 nn=ncont_sent(iproc)
7470 zapas(2,nn,iproc)=jjc
7471 zapas(3,nn,iproc)=d_cont(j,i)
7475 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7480 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7488 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7499 & "Numbers of contacts to be sent to other processors",
7500 & (ncont_sent(i),i=1,ntask_cont_to)
7501 write (iout,*) "Contacts sent"
7502 do ii=1,ntask_cont_to
7504 iproc=itask_cont_to(ii)
7505 write (iout,*) nn," contacts to processor",iproc,
7506 & " of CONT_TO_COMM group"
7508 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7516 CorrelID1=nfgtasks+fg_rank+1
7518 C Receive the numbers of needed contacts from other processors
7519 do ii=1,ntask_cont_from
7520 iproc=itask_cont_from(ii)
7522 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7523 & FG_COMM,req(ireq),IERR)
7525 c write (iout,*) "IRECV ended"
7527 C Send the number of contacts needed by other processors
7528 do ii=1,ntask_cont_to
7529 iproc=itask_cont_to(ii)
7531 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7532 & FG_COMM,req(ireq),IERR)
7534 c write (iout,*) "ISEND ended"
7535 c write (iout,*) "number of requests (nn)",ireq
7538 & call MPI_Waitall(ireq,req,status_array,ierr)
7540 c & "Numbers of contacts to be received from other processors",
7541 c & (ncont_recv(i),i=1,ntask_cont_from)
7545 do ii=1,ntask_cont_from
7546 iproc=itask_cont_from(ii)
7548 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7549 c & " of CONT_TO_COMM group"
7553 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7554 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7555 c write (iout,*) "ireq,req",ireq,req(ireq)
7558 C Send the contacts to processors that need them
7559 do ii=1,ntask_cont_to
7560 iproc=itask_cont_to(ii)
7562 c write (iout,*) nn," contacts to processor",iproc,
7563 c & " of CONT_TO_COMM group"
7566 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7567 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7568 c write (iout,*) "ireq,req",ireq,req(ireq)
7570 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7574 c write (iout,*) "number of requests (contacts)",ireq
7575 c write (iout,*) "req",(req(i),i=1,4)
7578 & call MPI_Waitall(ireq,req,status_array,ierr)
7579 do iii=1,ntask_cont_from
7580 iproc=itask_cont_from(iii)
7583 write (iout,*) "Received",nn," contacts from processor",iproc,
7584 & " of CONT_FROM_COMM group"
7587 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7592 ii=zapas_recv(1,i,iii)
7593 c Flag the received contacts to prevent double-counting
7594 jj=-zapas_recv(2,i,iii)
7595 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7597 nnn=num_cont_hb(ii)+1
7600 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7604 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7609 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7617 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7626 write (iout,'(a)') 'Contact function values after receive:'
7628 write (iout,'(2i3,50(1x,i3,5f6.3))')
7629 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7630 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7637 write (iout,'(a)') 'Contact function values:'
7639 write (iout,'(2i3,50(1x,i2,5f6.3))')
7640 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7641 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7647 C Remove the loop below after debugging !!!
7654 C Calculate the dipole-dipole interaction energies
7655 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7656 do i=iatel_s,iatel_e+1
7657 num_conti=num_cont_hb(i)
7666 C Calculate the local-electrostatic correlation terms
7667 c write (iout,*) "gradcorr5 in eello5 before loop"
7669 c write (iout,'(i5,3f10.5)')
7670 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7672 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7673 c write (iout,*) "corr loop i",i
7675 num_conti=num_cont_hb(i)
7676 num_conti1=num_cont_hb(i+1)
7683 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7684 c & ' jj=',jj,' kk=',kk
7685 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7686 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7687 & .or. j.lt.0 .and. j1.gt.0) .and.
7688 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7689 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7690 C The system gains extra energy.
7692 sqd1=dsqrt(d_cont(jj,i))
7693 sqd2=dsqrt(d_cont(kk,i1))
7694 sred_geom = sqd1*sqd2
7695 IF (sred_geom.lt.cutoff_corr) THEN
7696 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7698 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7699 cd & ' jj=',jj,' kk=',kk
7700 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7701 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7703 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7704 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7707 cd write (iout,*) 'sred_geom=',sred_geom,
7708 cd & ' ekont=',ekont,' fprim=',fprimcont,
7709 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7710 cd write (iout,*) "g_contij",g_contij
7711 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7712 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7713 call calc_eello(i,jp,i+1,jp1,jj,kk)
7714 if (wcorr4.gt.0.0d0)
7715 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7716 if (energy_dec.and.wcorr4.gt.0.0d0)
7717 1 write (iout,'(a6,4i5,0pf7.3)')
7718 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7719 c write (iout,*) "gradcorr5 before eello5"
7721 c write (iout,'(i5,3f10.5)')
7722 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7724 if (wcorr5.gt.0.0d0)
7725 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7726 c write (iout,*) "gradcorr5 after eello5"
7728 c write (iout,'(i5,3f10.5)')
7729 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7731 if (energy_dec.and.wcorr5.gt.0.0d0)
7732 1 write (iout,'(a6,4i5,0pf7.3)')
7733 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7734 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7735 cd write(2,*)'ijkl',i,jp,i+1,jp1
7736 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7737 & .or. wturn6.eq.0.0d0))then
7738 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7739 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7740 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7741 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7742 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7743 cd & 'ecorr6=',ecorr6
7744 cd write (iout,'(4e15.5)') sred_geom,
7745 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7746 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7747 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7748 else if (wturn6.gt.0.0d0
7749 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7750 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7751 eturn6=eturn6+eello_turn6(i,jj,kk)
7752 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7753 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7754 cd write (2,*) 'multibody_eello:eturn6',eturn6
7763 num_cont_hb(i)=num_cont_hb_old(i)
7765 c write (iout,*) "gradcorr5 in eello5"
7767 c write (iout,'(i5,3f10.5)')
7768 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7772 c------------------------------------------------------------------------------
7773 subroutine add_hb_contact_eello(ii,jj,itask)
7774 implicit real*8 (a-h,o-z)
7775 include "DIMENSIONS"
7776 include "COMMON.IOUNITS"
7779 parameter (max_cont=maxconts)
7780 parameter (max_dim=70)
7781 include "COMMON.CONTACTS"
7782 double precision zapas(max_dim,maxconts,max_fg_procs),
7783 & zapas_recv(max_dim,maxconts,max_fg_procs)
7784 common /przechowalnia/ zapas
7785 integer i,j,ii,jj,iproc,itask(4),nn
7786 c write (iout,*) "itask",itask
7789 if (iproc.gt.0) then
7790 do j=1,num_cont_hb(ii)
7792 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7794 ncont_sent(iproc)=ncont_sent(iproc)+1
7795 nn=ncont_sent(iproc)
7796 zapas(1,nn,iproc)=ii
7797 zapas(2,nn,iproc)=jjc
7798 zapas(3,nn,iproc)=d_cont(j,ii)
7802 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7807 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7815 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7827 c------------------------------------------------------------------------------
7828 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7829 implicit real*8 (a-h,o-z)
7830 include 'DIMENSIONS'
7831 include 'COMMON.IOUNITS'
7832 include 'COMMON.DERIV'
7833 include 'COMMON.INTERACT'
7834 include 'COMMON.CONTACTS'
7835 double precision gx(3),gx1(3)
7845 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7846 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7847 C Following 4 lines for diagnostics.
7852 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7853 c & 'Contacts ',i,j,
7854 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7855 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7857 C Calculate the multi-body contribution to energy.
7858 c ecorr=ecorr+ekont*ees
7859 C Calculate multi-body contributions to the gradient.
7860 coeffpees0pij=coeffp*ees0pij
7861 coeffmees0mij=coeffm*ees0mij
7862 coeffpees0pkl=coeffp*ees0pkl
7863 coeffmees0mkl=coeffm*ees0mkl
7865 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7866 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7867 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7868 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7869 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7870 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7871 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7872 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7873 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7874 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7875 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7876 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7877 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7878 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7879 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7880 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7881 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7882 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7883 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7884 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7885 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7886 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7887 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7888 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7889 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7894 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7895 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7896 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7897 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7902 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7903 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7904 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7905 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7908 c write (iout,*) "ehbcorr",ekont*ees
7913 C---------------------------------------------------------------------------
7914 subroutine dipole(i,j,jj)
7915 implicit real*8 (a-h,o-z)
7916 include 'DIMENSIONS'
7917 include 'COMMON.IOUNITS'
7918 include 'COMMON.CHAIN'
7919 include 'COMMON.FFIELD'
7920 include 'COMMON.DERIV'
7921 include 'COMMON.INTERACT'
7922 include 'COMMON.CONTACTS'
7923 include 'COMMON.TORSION'
7924 include 'COMMON.VAR'
7925 include 'COMMON.GEO'
7926 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7928 iti1 = itortyp(itype(i+1))
7929 if (j.lt.nres-1) then
7930 itj1 = itortyp(itype(j+1))
7935 dipi(iii,1)=Ub2(iii,i)
7936 dipderi(iii)=Ub2der(iii,i)
7937 dipi(iii,2)=b1(iii,i+1)
7938 dipj(iii,1)=Ub2(iii,j)
7939 dipderj(iii)=Ub2der(iii,j)
7940 dipj(iii,2)=b1(iii,j+1)
7944 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7947 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7954 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7958 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7963 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7964 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7966 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7968 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7970 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7975 C---------------------------------------------------------------------------
7976 subroutine calc_eello(i,j,k,l,jj,kk)
7978 C This subroutine computes matrices and vectors needed to calculate
7979 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7981 implicit real*8 (a-h,o-z)
7982 include 'DIMENSIONS'
7983 include 'COMMON.IOUNITS'
7984 include 'COMMON.CHAIN'
7985 include 'COMMON.DERIV'
7986 include 'COMMON.INTERACT'
7987 include 'COMMON.CONTACTS'
7988 include 'COMMON.TORSION'
7989 include 'COMMON.VAR'
7990 include 'COMMON.GEO'
7991 include 'COMMON.FFIELD'
7992 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7993 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7996 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7997 cd & ' jj=',jj,' kk=',kk
7998 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7999 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8000 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8003 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8004 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8007 call transpose2(aa1(1,1),aa1t(1,1))
8008 call transpose2(aa2(1,1),aa2t(1,1))
8011 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8012 & aa1tder(1,1,lll,kkk))
8013 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8014 & aa2tder(1,1,lll,kkk))
8018 C parallel orientation of the two CA-CA-CA frames.
8020 iti=itortyp(itype(i))
8024 itk1=itortyp(itype(k+1))
8025 itj=itortyp(itype(j))
8026 if (l.lt.nres-1) then
8027 itl1=itortyp(itype(l+1))
8031 C A1 kernel(j+1) A2T
8033 cd write (iout,'(3f10.5,5x,3f10.5)')
8034 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8036 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8037 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8038 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8039 C Following matrices are needed only for 6-th order cumulants
8040 IF (wcorr6.gt.0.0d0) THEN
8041 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8042 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8043 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8044 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8045 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8046 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8047 & ADtEAderx(1,1,1,1,1,1))
8049 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8050 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8051 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8052 & ADtEA1derx(1,1,1,1,1,1))
8054 C End 6-th order cumulants
8057 cd write (2,*) 'In calc_eello6'
8059 cd write (2,*) 'iii=',iii
8061 cd write (2,*) 'kkk=',kkk
8063 cd write (2,'(3(2f10.5),5x)')
8064 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8069 call transpose2(EUgder(1,1,k),auxmat(1,1))
8070 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8071 call transpose2(EUg(1,1,k),auxmat(1,1))
8072 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8073 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8077 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8078 & EAEAderx(1,1,lll,kkk,iii,1))
8082 C A1T kernel(i+1) A2
8083 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8084 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8085 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8086 C Following matrices are needed only for 6-th order cumulants
8087 IF (wcorr6.gt.0.0d0) THEN
8088 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8089 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
8090 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8091 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8092 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
8093 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8094 & ADtEAderx(1,1,1,1,1,2))
8095 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8096 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
8097 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8098 & ADtEA1derx(1,1,1,1,1,2))
8100 C End 6-th order cumulants
8101 call transpose2(EUgder(1,1,l),auxmat(1,1))
8102 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8103 call transpose2(EUg(1,1,l),auxmat(1,1))
8104 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8105 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8109 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8110 & EAEAderx(1,1,lll,kkk,iii,2))
8115 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8116 C They are needed only when the fifth- or the sixth-order cumulants are
8118 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8119 call transpose2(AEA(1,1,1),auxmat(1,1))
8120 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8121 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8122 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8123 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8124 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8125 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8126 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8127 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8128 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8129 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8130 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8131 call transpose2(AEA(1,1,2),auxmat(1,1))
8132 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
8133 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8134 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8135 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8136 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
8137 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8138 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
8139 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
8140 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8141 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8142 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8143 C Calculate the Cartesian derivatives of the vectors.
8147 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8148 call matvec2(auxmat(1,1),b1(1,i),
8149 & AEAb1derx(1,lll,kkk,iii,1,1))
8150 call matvec2(auxmat(1,1),Ub2(1,i),
8151 & AEAb2derx(1,lll,kkk,iii,1,1))
8152 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8153 & AEAb1derx(1,lll,kkk,iii,2,1))
8154 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8155 & AEAb2derx(1,lll,kkk,iii,2,1))
8156 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8157 call matvec2(auxmat(1,1),b1(1,j),
8158 & AEAb1derx(1,lll,kkk,iii,1,2))
8159 call matvec2(auxmat(1,1),Ub2(1,j),
8160 & AEAb2derx(1,lll,kkk,iii,1,2))
8161 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8162 & AEAb1derx(1,lll,kkk,iii,2,2))
8163 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
8164 & AEAb2derx(1,lll,kkk,iii,2,2))
8171 C Antiparallel orientation of the two CA-CA-CA frames.
8173 iti=itortyp(itype(i))
8177 itk1=itortyp(itype(k+1))
8178 itl=itortyp(itype(l))
8179 itj=itortyp(itype(j))
8180 if (j.lt.nres-1) then
8181 itj1=itortyp(itype(j+1))
8185 C A2 kernel(j-1)T A1T
8186 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8187 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
8188 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8189 C Following matrices are needed only for 6-th order cumulants
8190 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8191 & j.eq.i+4 .and. l.eq.i+3)) THEN
8192 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8193 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
8194 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8195 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8196 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8197 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8198 & ADtEAderx(1,1,1,1,1,1))
8199 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8200 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8201 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8202 & ADtEA1derx(1,1,1,1,1,1))
8204 C End 6-th order cumulants
8205 call transpose2(EUgder(1,1,k),auxmat(1,1))
8206 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8207 call transpose2(EUg(1,1,k),auxmat(1,1))
8208 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8209 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8213 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8214 & EAEAderx(1,1,lll,kkk,iii,1))
8218 C A2T kernel(i+1)T A1
8219 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8220 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
8221 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8222 C Following matrices are needed only for 6-th order cumulants
8223 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8224 & j.eq.i+4 .and. l.eq.i+3)) THEN
8225 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8226 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8227 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8228 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8229 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8230 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8231 & ADtEAderx(1,1,1,1,1,2))
8232 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8233 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8234 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8235 & ADtEA1derx(1,1,1,1,1,2))
8237 C End 6-th order cumulants
8238 call transpose2(EUgder(1,1,j),auxmat(1,1))
8239 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8240 call transpose2(EUg(1,1,j),auxmat(1,1))
8241 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8242 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8246 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8247 & EAEAderx(1,1,lll,kkk,iii,2))
8252 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8253 C They are needed only when the fifth- or the sixth-order cumulants are
8255 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8256 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8257 call transpose2(AEA(1,1,1),auxmat(1,1))
8258 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8259 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8260 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8261 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8262 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8263 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8264 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8265 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8266 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8267 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8268 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8269 call transpose2(AEA(1,1,2),auxmat(1,1))
8270 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
8271 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8272 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8273 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8274 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
8275 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8276 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
8277 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
8278 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8279 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8280 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8281 C Calculate the Cartesian derivatives of the vectors.
8285 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8286 call matvec2(auxmat(1,1),b1(1,i),
8287 & AEAb1derx(1,lll,kkk,iii,1,1))
8288 call matvec2(auxmat(1,1),Ub2(1,i),
8289 & AEAb2derx(1,lll,kkk,iii,1,1))
8290 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8291 & AEAb1derx(1,lll,kkk,iii,2,1))
8292 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8293 & AEAb2derx(1,lll,kkk,iii,2,1))
8294 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8295 call matvec2(auxmat(1,1),b1(1,l),
8296 & AEAb1derx(1,lll,kkk,iii,1,2))
8297 call matvec2(auxmat(1,1),Ub2(1,l),
8298 & AEAb2derx(1,lll,kkk,iii,1,2))
8299 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
8300 & AEAb1derx(1,lll,kkk,iii,2,2))
8301 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8302 & AEAb2derx(1,lll,kkk,iii,2,2))
8311 C---------------------------------------------------------------------------
8312 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8313 & KK,KKderg,AKA,AKAderg,AKAderx)
8317 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8318 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8319 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8324 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8326 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8329 cd if (lprn) write (2,*) 'In kernel'
8331 cd if (lprn) write (2,*) 'kkk=',kkk
8333 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8334 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8336 cd write (2,*) 'lll=',lll
8337 cd write (2,*) 'iii=1'
8339 cd write (2,'(3(2f10.5),5x)')
8340 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8343 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8344 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8346 cd write (2,*) 'lll=',lll
8347 cd write (2,*) 'iii=2'
8349 cd write (2,'(3(2f10.5),5x)')
8350 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8357 C---------------------------------------------------------------------------
8358 double precision function eello4(i,j,k,l,jj,kk)
8359 implicit real*8 (a-h,o-z)
8360 include 'DIMENSIONS'
8361 include 'COMMON.IOUNITS'
8362 include 'COMMON.CHAIN'
8363 include 'COMMON.DERIV'
8364 include 'COMMON.INTERACT'
8365 include 'COMMON.CONTACTS'
8366 include 'COMMON.TORSION'
8367 include 'COMMON.VAR'
8368 include 'COMMON.GEO'
8369 double precision pizda(2,2),ggg1(3),ggg2(3)
8370 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8374 cd print *,'eello4:',i,j,k,l,jj,kk
8375 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8376 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8377 cold eij=facont_hb(jj,i)
8378 cold ekl=facont_hb(kk,k)
8380 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8381 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8382 gcorr_loc(k-1)=gcorr_loc(k-1)
8383 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8385 gcorr_loc(l-1)=gcorr_loc(l-1)
8386 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8388 gcorr_loc(j-1)=gcorr_loc(j-1)
8389 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8394 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8395 & -EAEAderx(2,2,lll,kkk,iii,1)
8396 cd derx(lll,kkk,iii)=0.0d0
8400 cd gcorr_loc(l-1)=0.0d0
8401 cd gcorr_loc(j-1)=0.0d0
8402 cd gcorr_loc(k-1)=0.0d0
8404 cd write (iout,*)'Contacts have occurred for peptide groups',
8405 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8406 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8407 if (j.lt.nres-1) then
8414 if (l.lt.nres-1) then
8422 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8423 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8424 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8425 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8426 cgrad ghalf=0.5d0*ggg1(ll)
8427 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8428 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8429 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8430 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8431 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8432 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8433 cgrad ghalf=0.5d0*ggg2(ll)
8434 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8435 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8436 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8437 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8438 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8439 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8443 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8448 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8453 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8458 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8462 cd write (2,*) iii,gcorr_loc(iii)
8465 cd write (2,*) 'ekont',ekont
8466 cd write (iout,*) 'eello4',ekont*eel4
8469 C---------------------------------------------------------------------------
8470 double precision function eello5(i,j,k,l,jj,kk)
8471 implicit real*8 (a-h,o-z)
8472 include 'DIMENSIONS'
8473 include 'COMMON.IOUNITS'
8474 include 'COMMON.CHAIN'
8475 include 'COMMON.DERIV'
8476 include 'COMMON.INTERACT'
8477 include 'COMMON.CONTACTS'
8478 include 'COMMON.TORSION'
8479 include 'COMMON.VAR'
8480 include 'COMMON.GEO'
8481 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8482 double precision ggg1(3),ggg2(3)
8483 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8488 C /l\ / \ \ / \ / \ / C
8489 C / \ / \ \ / \ / \ / C
8490 C j| o |l1 | o | o| o | | o |o C
8491 C \ |/k\| |/ \| / |/ \| |/ \| C
8492 C \i/ \ / \ / / \ / \ C
8494 C (I) (II) (III) (IV) C
8496 C eello5_1 eello5_2 eello5_3 eello5_4 C
8498 C Antiparallel chains C
8501 C /j\ / \ \ / \ / \ / C
8502 C / \ / \ \ / \ / \ / C
8503 C j1| o |l | o | o| o | | o |o C
8504 C \ |/k\| |/ \| / |/ \| |/ \| C
8505 C \i/ \ / \ / / \ / \ C
8507 C (I) (II) (III) (IV) C
8509 C eello5_1 eello5_2 eello5_3 eello5_4 C
8511 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8513 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8514 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8519 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8521 itk=itortyp(itype(k))
8522 itl=itortyp(itype(l))
8523 itj=itortyp(itype(j))
8528 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8529 cd & eel5_3_num,eel5_4_num)
8533 derx(lll,kkk,iii)=0.0d0
8537 cd eij=facont_hb(jj,i)
8538 cd ekl=facont_hb(kk,k)
8540 cd write (iout,*)'Contacts have occurred for peptide groups',
8541 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8543 C Contribution from the graph I.
8544 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8545 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8546 call transpose2(EUg(1,1,k),auxmat(1,1))
8547 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8548 vv(1)=pizda(1,1)-pizda(2,2)
8549 vv(2)=pizda(1,2)+pizda(2,1)
8550 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8551 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8552 C Explicit gradient in virtual-dihedral angles.
8553 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8554 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8555 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8556 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8557 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8558 vv(1)=pizda(1,1)-pizda(2,2)
8559 vv(2)=pizda(1,2)+pizda(2,1)
8560 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8561 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8562 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8563 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8564 vv(1)=pizda(1,1)-pizda(2,2)
8565 vv(2)=pizda(1,2)+pizda(2,1)
8567 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8568 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8569 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8571 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8572 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8573 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8575 C Cartesian gradient
8579 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8581 vv(1)=pizda(1,1)-pizda(2,2)
8582 vv(2)=pizda(1,2)+pizda(2,1)
8583 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8584 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8585 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8591 C Contribution from graph II
8592 call transpose2(EE(1,1,itk),auxmat(1,1))
8593 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8594 vv(1)=pizda(1,1)+pizda(2,2)
8595 vv(2)=pizda(2,1)-pizda(1,2)
8596 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8597 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8598 C Explicit gradient in virtual-dihedral angles.
8599 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8600 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8601 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8602 vv(1)=pizda(1,1)+pizda(2,2)
8603 vv(2)=pizda(2,1)-pizda(1,2)
8605 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8606 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8607 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8609 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8610 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8611 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8613 C Cartesian gradient
8617 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8619 vv(1)=pizda(1,1)+pizda(2,2)
8620 vv(2)=pizda(2,1)-pizda(1,2)
8621 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8622 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8623 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8631 C Parallel orientation
8632 C Contribution from graph III
8633 call transpose2(EUg(1,1,l),auxmat(1,1))
8634 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8635 vv(1)=pizda(1,1)-pizda(2,2)
8636 vv(2)=pizda(1,2)+pizda(2,1)
8637 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8638 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8639 C Explicit gradient in virtual-dihedral angles.
8640 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8641 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8642 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8643 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8644 vv(1)=pizda(1,1)-pizda(2,2)
8645 vv(2)=pizda(1,2)+pizda(2,1)
8646 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8647 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8648 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8649 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8650 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8651 vv(1)=pizda(1,1)-pizda(2,2)
8652 vv(2)=pizda(1,2)+pizda(2,1)
8653 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8654 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8655 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8656 C Cartesian gradient
8660 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8662 vv(1)=pizda(1,1)-pizda(2,2)
8663 vv(2)=pizda(1,2)+pizda(2,1)
8664 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8665 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8666 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8671 C Contribution from graph IV
8673 call transpose2(EE(1,1,itl),auxmat(1,1))
8674 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8675 vv(1)=pizda(1,1)+pizda(2,2)
8676 vv(2)=pizda(2,1)-pizda(1,2)
8677 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8678 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8679 C Explicit gradient in virtual-dihedral angles.
8680 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8681 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8682 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8683 vv(1)=pizda(1,1)+pizda(2,2)
8684 vv(2)=pizda(2,1)-pizda(1,2)
8685 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8686 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8687 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8688 C Cartesian gradient
8692 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8694 vv(1)=pizda(1,1)+pizda(2,2)
8695 vv(2)=pizda(2,1)-pizda(1,2)
8696 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8697 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
8698 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8703 C Antiparallel orientation
8704 C Contribution from graph III
8706 call transpose2(EUg(1,1,j),auxmat(1,1))
8707 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8708 vv(1)=pizda(1,1)-pizda(2,2)
8709 vv(2)=pizda(1,2)+pizda(2,1)
8710 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8711 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8712 C Explicit gradient in virtual-dihedral angles.
8713 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8714 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8715 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8716 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8717 vv(1)=pizda(1,1)-pizda(2,2)
8718 vv(2)=pizda(1,2)+pizda(2,1)
8719 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8720 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8721 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8722 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8723 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8724 vv(1)=pizda(1,1)-pizda(2,2)
8725 vv(2)=pizda(1,2)+pizda(2,1)
8726 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8727 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8728 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8729 C Cartesian gradient
8733 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8735 vv(1)=pizda(1,1)-pizda(2,2)
8736 vv(2)=pizda(1,2)+pizda(2,1)
8737 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8738 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8739 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8744 C Contribution from graph IV
8746 call transpose2(EE(1,1,itj),auxmat(1,1))
8747 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8748 vv(1)=pizda(1,1)+pizda(2,2)
8749 vv(2)=pizda(2,1)-pizda(1,2)
8750 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
8751 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8752 C Explicit gradient in virtual-dihedral angles.
8753 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8754 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8755 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8756 vv(1)=pizda(1,1)+pizda(2,2)
8757 vv(2)=pizda(2,1)-pizda(1,2)
8758 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8759 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
8760 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8761 C Cartesian gradient
8765 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8767 vv(1)=pizda(1,1)+pizda(2,2)
8768 vv(2)=pizda(2,1)-pizda(1,2)
8769 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8770 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
8771 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8777 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8778 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8779 cd write (2,*) 'ijkl',i,j,k,l
8780 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8781 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8783 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8784 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8785 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8786 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8787 if (j.lt.nres-1) then
8794 if (l.lt.nres-1) then
8804 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8805 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8806 C summed up outside the subrouine as for the other subroutines
8807 C handling long-range interactions. The old code is commented out
8808 C with "cgrad" to keep track of changes.
8810 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8811 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8812 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8813 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8814 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8815 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8816 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8817 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8818 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8819 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8821 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8822 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8823 cgrad ghalf=0.5d0*ggg1(ll)
8825 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8826 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8827 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8828 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8829 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8830 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8831 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8832 cgrad ghalf=0.5d0*ggg2(ll)
8834 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8835 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8836 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8837 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8838 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8839 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8844 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8845 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8850 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8851 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8857 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8862 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8866 cd write (2,*) iii,g_corr5_loc(iii)
8869 cd write (2,*) 'ekont',ekont
8870 cd write (iout,*) 'eello5',ekont*eel5
8873 c--------------------------------------------------------------------------
8874 double precision function eello6(i,j,k,l,jj,kk)
8875 implicit real*8 (a-h,o-z)
8876 include 'DIMENSIONS'
8877 include 'COMMON.IOUNITS'
8878 include 'COMMON.CHAIN'
8879 include 'COMMON.DERIV'
8880 include 'COMMON.INTERACT'
8881 include 'COMMON.CONTACTS'
8882 include 'COMMON.TORSION'
8883 include 'COMMON.VAR'
8884 include 'COMMON.GEO'
8885 include 'COMMON.FFIELD'
8886 double precision ggg1(3),ggg2(3)
8887 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8892 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8900 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8901 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8905 derx(lll,kkk,iii)=0.0d0
8909 cd eij=facont_hb(jj,i)
8910 cd ekl=facont_hb(kk,k)
8916 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8917 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8918 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8919 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8920 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8921 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8923 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8924 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8925 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8926 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8927 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8928 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8932 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8934 C If turn contributions are considered, they will be handled separately.
8935 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8936 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8937 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8938 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8939 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8940 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8941 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8943 if (j.lt.nres-1) then
8950 if (l.lt.nres-1) then
8958 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8959 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8960 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8961 cgrad ghalf=0.5d0*ggg1(ll)
8963 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8964 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8965 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8966 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8967 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8968 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8969 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8970 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8971 cgrad ghalf=0.5d0*ggg2(ll)
8972 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8974 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8975 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8976 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8977 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8978 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8979 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8984 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8985 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8990 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8991 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8997 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9002 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9006 cd write (2,*) iii,g_corr6_loc(iii)
9009 cd write (2,*) 'ekont',ekont
9010 cd write (iout,*) 'eello6',ekont*eel6
9013 c--------------------------------------------------------------------------
9014 double precision function eello6_graph1(i,j,k,l,imat,swap)
9015 implicit real*8 (a-h,o-z)
9016 include 'DIMENSIONS'
9017 include 'COMMON.IOUNITS'
9018 include 'COMMON.CHAIN'
9019 include 'COMMON.DERIV'
9020 include 'COMMON.INTERACT'
9021 include 'COMMON.CONTACTS'
9022 include 'COMMON.TORSION'
9023 include 'COMMON.VAR'
9024 include 'COMMON.GEO'
9025 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9029 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9031 C Parallel Antiparallel C
9037 C \ j|/k\| / \ |/k\|l / C
9042 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9043 itk=itortyp(itype(k))
9044 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9045 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9046 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9047 call transpose2(EUgC(1,1,k),auxmat(1,1))
9048 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9049 vv1(1)=pizda1(1,1)-pizda1(2,2)
9050 vv1(2)=pizda1(1,2)+pizda1(2,1)
9051 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9052 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
9053 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
9054 s5=scalar2(vv(1),Dtobr2(1,i))
9055 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9056 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9057 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9058 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9059 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9060 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9061 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9062 & +scalar2(vv(1),Dtobr2der(1,i)))
9063 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9064 vv1(1)=pizda1(1,1)-pizda1(2,2)
9065 vv1(2)=pizda1(1,2)+pizda1(2,1)
9066 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
9067 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
9069 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9070 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9071 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9072 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9073 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9075 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9076 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9077 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9078 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9079 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9081 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9082 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9083 vv1(1)=pizda1(1,1)-pizda1(2,2)
9084 vv1(2)=pizda1(1,2)+pizda1(2,1)
9085 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9086 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9087 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
9088 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9097 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9098 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9099 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9100 call transpose2(EUgC(1,1,k),auxmat(1,1))
9101 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9103 vv1(1)=pizda1(1,1)-pizda1(2,2)
9104 vv1(2)=pizda1(1,2)+pizda1(2,1)
9105 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9106 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
9107 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
9108 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
9109 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
9110 s5=scalar2(vv(1),Dtobr2(1,i))
9111 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9117 c----------------------------------------------------------------------------
9118 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
9119 implicit real*8 (a-h,o-z)
9120 include 'DIMENSIONS'
9121 include 'COMMON.IOUNITS'
9122 include 'COMMON.CHAIN'
9123 include 'COMMON.DERIV'
9124 include 'COMMON.INTERACT'
9125 include 'COMMON.CONTACTS'
9126 include 'COMMON.TORSION'
9127 include 'COMMON.VAR'
9128 include 'COMMON.GEO'
9130 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9131 & auxvec1(2),auxvec2(2),auxmat1(2,2)
9134 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9136 C Parallel Antiparallel C
9142 C \ j|/k\| \ |/k\|l C
9147 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9148 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9149 C AL 7/4/01 s1 would occur in the sixth-order moment,
9150 C but not in a cluster cumulant
9152 s1=dip(1,jj,i)*dip(1,kk,k)
9154 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9155 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9156 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9157 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9158 call transpose2(EUg(1,1,k),auxmat(1,1))
9159 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9160 vv(1)=pizda(1,1)-pizda(2,2)
9161 vv(2)=pizda(1,2)+pizda(2,1)
9162 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9163 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9165 eello6_graph2=-(s1+s2+s3+s4)
9167 eello6_graph2=-(s2+s3+s4)
9170 C Derivatives in gamma(i-1)
9173 s1=dipderg(1,jj,i)*dip(1,kk,k)
9175 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9176 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9177 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9178 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9180 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9182 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9184 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9186 C Derivatives in gamma(k-1)
9188 s1=dip(1,jj,i)*dipderg(1,kk,k)
9190 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9191 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9192 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9193 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9194 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9195 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9196 vv(1)=pizda(1,1)-pizda(2,2)
9197 vv(2)=pizda(1,2)+pizda(2,1)
9198 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9200 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9202 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9204 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9205 C Derivatives in gamma(j-1) or gamma(l-1)
9208 s1=dipderg(3,jj,i)*dip(1,kk,k)
9210 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9211 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9212 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9213 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9214 vv(1)=pizda(1,1)-pizda(2,2)
9215 vv(2)=pizda(1,2)+pizda(2,1)
9216 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9219 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9221 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9224 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9225 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9227 C Derivatives in gamma(l-1) or gamma(j-1)
9230 s1=dip(1,jj,i)*dipderg(3,kk,k)
9232 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9233 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9234 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9235 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9236 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9237 vv(1)=pizda(1,1)-pizda(2,2)
9238 vv(2)=pizda(1,2)+pizda(2,1)
9239 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9242 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9244 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9247 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9248 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9250 C Cartesian derivatives.
9252 write (2,*) 'In eello6_graph2'
9254 write (2,*) 'iii=',iii
9256 write (2,*) 'kkk=',kkk
9258 write (2,'(3(2f10.5),5x)')
9259 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9269 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9271 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9274 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9276 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9277 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9279 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9280 call transpose2(EUg(1,1,k),auxmat(1,1))
9281 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9283 vv(1)=pizda(1,1)-pizda(2,2)
9284 vv(2)=pizda(1,2)+pizda(2,1)
9285 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9286 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9288 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9290 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9293 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9295 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9302 c----------------------------------------------------------------------------
9303 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9304 implicit real*8 (a-h,o-z)
9305 include 'DIMENSIONS'
9306 include 'COMMON.IOUNITS'
9307 include 'COMMON.CHAIN'
9308 include 'COMMON.DERIV'
9309 include 'COMMON.INTERACT'
9310 include 'COMMON.CONTACTS'
9311 include 'COMMON.TORSION'
9312 include 'COMMON.VAR'
9313 include 'COMMON.GEO'
9314 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9316 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9318 C Parallel Antiparallel C
9324 C j|/k\| / |/k\|l / C
9329 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9331 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9332 C energy moment and not to the cluster cumulant.
9333 iti=itortyp(itype(i))
9334 if (j.lt.nres-1) then
9335 itj1=itortyp(itype(j+1))
9339 itk=itortyp(itype(k))
9340 itk1=itortyp(itype(k+1))
9341 if (l.lt.nres-1) then
9342 itl1=itortyp(itype(l+1))
9347 s1=dip(4,jj,i)*dip(4,kk,k)
9349 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
9350 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9351 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
9352 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9353 call transpose2(EE(1,1,itk),auxmat(1,1))
9354 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9355 vv(1)=pizda(1,1)+pizda(2,2)
9356 vv(2)=pizda(2,1)-pizda(1,2)
9357 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9358 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9359 cd & "sum",-(s2+s3+s4)
9361 eello6_graph3=-(s1+s2+s3+s4)
9363 eello6_graph3=-(s2+s3+s4)
9366 C Derivatives in gamma(k-1)
9367 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
9368 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9369 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9370 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9371 C Derivatives in gamma(l-1)
9372 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
9373 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9374 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9375 vv(1)=pizda(1,1)+pizda(2,2)
9376 vv(2)=pizda(2,1)-pizda(1,2)
9377 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9378 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9379 C Cartesian derivatives.
9385 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9387 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9390 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9392 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9393 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9395 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9396 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9398 vv(1)=pizda(1,1)+pizda(2,2)
9399 vv(2)=pizda(2,1)-pizda(1,2)
9400 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9402 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9404 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9407 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9409 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9411 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9417 c----------------------------------------------------------------------------
9418 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9419 implicit real*8 (a-h,o-z)
9420 include 'DIMENSIONS'
9421 include 'COMMON.IOUNITS'
9422 include 'COMMON.CHAIN'
9423 include 'COMMON.DERIV'
9424 include 'COMMON.INTERACT'
9425 include 'COMMON.CONTACTS'
9426 include 'COMMON.TORSION'
9427 include 'COMMON.VAR'
9428 include 'COMMON.GEO'
9429 include 'COMMON.FFIELD'
9430 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9431 & auxvec1(2),auxmat1(2,2)
9433 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9435 C Parallel Antiparallel C
9441 C \ j|/k\| \ |/k\|l C
9446 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9448 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9449 C energy moment and not to the cluster cumulant.
9450 cd write (2,*) 'eello_graph4: wturn6',wturn6
9451 iti=itortyp(itype(i))
9452 itj=itortyp(itype(j))
9453 if (j.lt.nres-1) then
9454 itj1=itortyp(itype(j+1))
9458 itk=itortyp(itype(k))
9459 if (k.lt.nres-1) then
9460 itk1=itortyp(itype(k+1))
9464 itl=itortyp(itype(l))
9465 if (l.lt.nres-1) then
9466 itl1=itortyp(itype(l+1))
9470 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9471 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9472 cd & ' itl',itl,' itl1',itl1
9475 s1=dip(3,jj,i)*dip(3,kk,k)
9477 s1=dip(2,jj,j)*dip(2,kk,l)
9480 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9481 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9483 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9484 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9486 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9487 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9489 call transpose2(EUg(1,1,k),auxmat(1,1))
9490 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9491 vv(1)=pizda(1,1)-pizda(2,2)
9492 vv(2)=pizda(2,1)+pizda(1,2)
9493 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9494 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9496 eello6_graph4=-(s1+s2+s3+s4)
9498 eello6_graph4=-(s2+s3+s4)
9500 C Derivatives in gamma(i-1)
9504 s1=dipderg(2,jj,i)*dip(3,kk,k)
9506 s1=dipderg(4,jj,j)*dip(2,kk,l)
9509 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9511 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9512 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9514 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9515 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9517 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9518 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9519 cd write (2,*) 'turn6 derivatives'
9521 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9523 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9527 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9529 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9533 C Derivatives in gamma(k-1)
9536 s1=dip(3,jj,i)*dipderg(2,kk,k)
9538 s1=dip(2,jj,j)*dipderg(4,kk,l)
9541 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9542 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9544 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9545 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9547 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9548 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9550 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9551 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9552 vv(1)=pizda(1,1)-pizda(2,2)
9553 vv(2)=pizda(2,1)+pizda(1,2)
9554 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9555 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9557 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9559 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9563 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9565 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9568 C Derivatives in gamma(j-1) or gamma(l-1)
9569 if (l.eq.j+1 .and. l.gt.1) then
9570 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9571 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9572 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9573 vv(1)=pizda(1,1)-pizda(2,2)
9574 vv(2)=pizda(2,1)+pizda(1,2)
9575 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9576 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9577 else if (j.gt.1) then
9578 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9579 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9580 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9581 vv(1)=pizda(1,1)-pizda(2,2)
9582 vv(2)=pizda(2,1)+pizda(1,2)
9583 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9584 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9585 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9587 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9590 C Cartesian derivatives.
9597 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9599 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9603 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9605 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9609 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9611 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9613 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9614 & b1(1,j+1),auxvec(1))
9615 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9617 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9618 & b1(1,l+1),auxvec(1))
9619 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9621 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9623 vv(1)=pizda(1,1)-pizda(2,2)
9624 vv(2)=pizda(2,1)+pizda(1,2)
9625 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9627 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9629 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9632 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9635 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9638 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9640 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9642 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9646 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9648 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9651 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9653 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9661 c----------------------------------------------------------------------------
9662 double precision function eello_turn6(i,jj,kk)
9663 implicit real*8 (a-h,o-z)
9664 include 'DIMENSIONS'
9665 include 'COMMON.IOUNITS'
9666 include 'COMMON.CHAIN'
9667 include 'COMMON.DERIV'
9668 include 'COMMON.INTERACT'
9669 include 'COMMON.CONTACTS'
9670 include 'COMMON.TORSION'
9671 include 'COMMON.VAR'
9672 include 'COMMON.GEO'
9673 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9674 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9676 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9677 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9678 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9679 C the respective energy moment and not to the cluster cumulant.
9688 iti=itortyp(itype(i))
9689 itk=itortyp(itype(k))
9690 itk1=itortyp(itype(k+1))
9691 itl=itortyp(itype(l))
9692 itj=itortyp(itype(j))
9693 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9694 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9695 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9700 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9702 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9706 derx_turn(lll,kkk,iii)=0.0d0
9713 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9715 cd write (2,*) 'eello6_5',eello6_5
9717 call transpose2(AEA(1,1,1),auxmat(1,1))
9718 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9719 ss1=scalar2(Ub2(1,i+2),b1(1,l))
9720 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9722 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9723 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9724 s2 = scalar2(b1(1,k),vtemp1(1))
9726 call transpose2(AEA(1,1,2),atemp(1,1))
9727 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9728 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9729 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9731 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9732 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9733 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9735 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9736 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9737 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9738 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9739 ss13 = scalar2(b1(1,k),vtemp4(1))
9740 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9742 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9748 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9749 C Derivatives in gamma(i+2)
9753 call transpose2(AEA(1,1,1),auxmatd(1,1))
9754 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9755 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9756 call transpose2(AEAderg(1,1,2),atempd(1,1))
9757 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9758 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9760 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9761 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9762 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9768 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9769 C Derivatives in gamma(i+3)
9771 call transpose2(AEA(1,1,1),auxmatd(1,1))
9772 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9773 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
9774 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9776 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
9777 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9778 s2d = scalar2(b1(1,k),vtemp1d(1))
9780 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9781 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9783 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9785 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9786 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9787 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9795 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9796 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9798 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9799 & -0.5d0*ekont*(s2d+s12d)
9801 C Derivatives in gamma(i+4)
9802 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9803 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9804 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9806 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9807 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9808 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9816 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9818 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9820 C Derivatives in gamma(i+5)
9822 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9823 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9824 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9826 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
9827 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9828 s2d = scalar2(b1(1,k),vtemp1d(1))
9830 call transpose2(AEA(1,1,2),atempd(1,1))
9831 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9832 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9834 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9835 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9837 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9838 ss13d = scalar2(b1(1,k),vtemp4d(1))
9839 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9847 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9848 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9850 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9851 & -0.5d0*ekont*(s2d+s12d)
9853 C Cartesian derivatives
9858 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9859 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9860 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9862 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9863 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9865 s2d = scalar2(b1(1,k),vtemp1d(1))
9867 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9868 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9869 s8d = -(atempd(1,1)+atempd(2,2))*
9870 & scalar2(cc(1,1,itl),vtemp2(1))
9872 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9874 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9875 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9882 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9885 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9889 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9890 & - 0.5d0*(s8d+s12d)
9892 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9901 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9903 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9904 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9905 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9906 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9907 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9909 ss13d = scalar2(b1(1,k),vtemp4d(1))
9910 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9911 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9915 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9916 cd & 16*eel_turn6_num
9918 if (j.lt.nres-1) then
9925 if (l.lt.nres-1) then
9933 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9934 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9935 cgrad ghalf=0.5d0*ggg1(ll)
9937 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9938 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9939 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9940 & +ekont*derx_turn(ll,2,1)
9941 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9942 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9943 & +ekont*derx_turn(ll,4,1)
9944 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9945 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9946 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9947 cgrad ghalf=0.5d0*ggg2(ll)
9949 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9950 & +ekont*derx_turn(ll,2,2)
9951 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9952 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9953 & +ekont*derx_turn(ll,4,2)
9954 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9955 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9956 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9961 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9966 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9972 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9977 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9981 cd write (2,*) iii,g_corr6_loc(iii)
9983 eello_turn6=ekont*eel_turn6
9984 cd write (2,*) 'ekont',ekont
9985 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9989 C-----------------------------------------------------------------------------
9990 double precision function scalar(u,v)
9991 !DIR$ INLINEALWAYS scalar
9993 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9996 double precision u(3),v(3)
9997 cd double precision sc
10005 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
10008 crc-------------------------------------------------
10009 SUBROUTINE MATVEC2(A1,V1,V2)
10010 !DIR$ INLINEALWAYS MATVEC2
10012 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10014 implicit real*8 (a-h,o-z)
10015 include 'DIMENSIONS'
10016 DIMENSION A1(2,2),V1(2),V2(2)
10020 c 3 VI=VI+A1(I,K)*V1(K)
10024 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10025 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10030 C---------------------------------------
10031 SUBROUTINE MATMAT2(A1,A2,A3)
10033 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10035 implicit real*8 (a-h,o-z)
10036 include 'DIMENSIONS'
10037 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10038 c DIMENSION AI3(2,2)
10042 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10048 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10049 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10050 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10051 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10059 c-------------------------------------------------------------------------
10060 double precision function scalar2(u,v)
10061 !DIR$ INLINEALWAYS scalar2
10063 double precision u(2),v(2)
10064 double precision sc
10066 scalar2=u(1)*v(1)+u(2)*v(2)
10070 C-----------------------------------------------------------------------------
10072 subroutine transpose2(a,at)
10073 !DIR$ INLINEALWAYS transpose2
10075 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
10078 double precision a(2,2),at(2,2)
10085 c--------------------------------------------------------------------------
10086 subroutine transpose(n,a,at)
10089 double precision a(n,n),at(n,n)
10097 C---------------------------------------------------------------------------
10098 subroutine prodmat3(a1,a2,kk,transp,prod)
10099 !DIR$ INLINEALWAYS prodmat3
10101 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
10105 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
10107 crc double precision auxmat(2,2),prod_(2,2)
10110 crc call transpose2(kk(1,1),auxmat(1,1))
10111 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10112 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10114 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
10115 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10116 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
10117 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10118 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
10119 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10120 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
10121 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10124 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10125 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10127 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
10128 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10129 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
10130 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10131 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
10132 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10133 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
10134 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10137 c call transpose2(a2(1,1),a2t(1,1))
10140 crc print *,((prod_(i,j),i=1,2),j=1,2)
10141 crc print *,((prod(i,j),i=1,2),j=1,2)
10145 CCC----------------------------------------------
10146 subroutine Eliptransfer(eliptran)
10147 implicit real*8 (a-h,o-z)
10148 include 'DIMENSIONS'
10149 include 'COMMON.GEO'
10150 include 'COMMON.VAR'
10151 include 'COMMON.LOCAL'
10152 include 'COMMON.CHAIN'
10153 include 'COMMON.DERIV'
10154 include 'COMMON.NAMES'
10155 include 'COMMON.INTERACT'
10156 include 'COMMON.IOUNITS'
10157 include 'COMMON.CALC'
10158 include 'COMMON.CONTROL'
10159 include 'COMMON.SPLITELE'
10160 include 'COMMON.SBRIDGE'
10161 C this is done by Adasko
10162 C print *,"wchodze"
10163 C structure of box:
10165 C--bordliptop-- buffore starts
10166 C--bufliptop--- here true lipid starts
10168 C--buflipbot--- lipid ends buffore starts
10169 C--bordlipbot--buffore ends
10171 do i=ilip_start,ilip_end
10173 if (itype(i).eq.ntyp1) cycle
10175 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
10176 if (positi.le.0) positi=positi+boxzsize
10178 C first for peptide groups
10179 c for each residue check if it is in lipid or lipid water border area
10180 if ((positi.gt.bordlipbot)
10181 &.and.(positi.lt.bordliptop)) then
10182 C the energy transfer exist
10183 if (positi.lt.buflipbot) then
10184 C what fraction I am in
10186 & ((positi-bordlipbot)/lipbufthick)
10187 C lipbufthick is thickenes of lipid buffore
10188 sslip=sscalelip(fracinbuf)
10189 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10190 eliptran=eliptran+sslip*pepliptran
10191 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10192 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10193 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10195 C print *,"doing sccale for lower part"
10196 C print *,i,sslip,fracinbuf,ssgradlip
10197 elseif (positi.gt.bufliptop) then
10198 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
10199 sslip=sscalelip(fracinbuf)
10200 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10201 eliptran=eliptran+sslip*pepliptran
10202 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10203 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10204 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10205 C print *, "doing sscalefor top part"
10206 C print *,i,sslip,fracinbuf,ssgradlip
10208 eliptran=eliptran+pepliptran
10209 C print *,"I am in true lipid"
10212 C eliptran=elpitran+0.0 ! I am in water
10215 C print *, "nic nie bylo w lipidzie?"
10216 C now multiply all by the peptide group transfer factor
10217 C eliptran=eliptran*pepliptran
10218 C now the same for side chains
10220 do i=ilip_start,ilip_end
10221 if (itype(i).eq.ntyp1) cycle
10222 positi=(mod(c(3,i+nres),boxzsize))
10223 if (positi.le.0) positi=positi+boxzsize
10224 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
10225 c for each residue check if it is in lipid or lipid water border area
10226 C respos=mod(c(3,i+nres),boxzsize)
10227 C print *,positi,bordlipbot,buflipbot
10228 if ((positi.gt.bordlipbot)
10229 & .and.(positi.lt.bordliptop)) then
10230 C the energy transfer exist
10231 if (positi.lt.buflipbot) then
10233 & ((positi-bordlipbot)/lipbufthick)
10234 C lipbufthick is thickenes of lipid buffore
10235 sslip=sscalelip(fracinbuf)
10236 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10237 eliptran=eliptran+sslip*liptranene(itype(i))
10238 gliptranx(3,i)=gliptranx(3,i)
10239 &+ssgradlip*liptranene(itype(i))
10240 gliptranc(3,i-1)= gliptranc(3,i-1)
10241 &+ssgradlip*liptranene(itype(i))
10242 C print *,"doing sccale for lower part"
10243 elseif (positi.gt.bufliptop) then
10245 &((bordliptop-positi)/lipbufthick)
10246 sslip=sscalelip(fracinbuf)
10247 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10248 eliptran=eliptran+sslip*liptranene(itype(i))
10249 gliptranx(3,i)=gliptranx(3,i)
10250 &+ssgradlip*liptranene(itype(i))
10251 gliptranc(3,i-1)= gliptranc(3,i-1)
10252 &+ssgradlip*liptranene(itype(i))
10253 C print *, "doing sscalefor top part",sslip,fracinbuf
10255 eliptran=eliptran+liptranene(itype(i))
10256 C print *,"I am in true lipid"
10258 endif ! if in lipid or buffor
10260 C eliptran=elpitran+0.0 ! I am in water
10264 C---------------------------------------------------------
10265 C AFM soubroutine for constant force
10266 subroutine AFMforce(Eafmforce)
10267 implicit real*8 (a-h,o-z)
10268 include 'DIMENSIONS'
10269 include 'COMMON.GEO'
10270 include 'COMMON.VAR'
10271 include 'COMMON.LOCAL'
10272 include 'COMMON.CHAIN'
10273 include 'COMMON.DERIV'
10274 include 'COMMON.NAMES'
10275 include 'COMMON.INTERACT'
10276 include 'COMMON.IOUNITS'
10277 include 'COMMON.CALC'
10278 include 'COMMON.CONTROL'
10279 include 'COMMON.SPLITELE'
10280 include 'COMMON.SBRIDGE'
10285 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10286 dist=dist+diffafm(i)**2
10289 Eafmforce=-forceAFMconst*(dist-distafminit)
10291 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
10292 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
10294 C print *,'AFM',Eafmforce
10297 C---------------------------------------------------------
10298 C AFM subroutine with pseudoconstant velocity
10299 subroutine AFMvel(Eafmforce)
10300 implicit real*8 (a-h,o-z)
10301 include 'DIMENSIONS'
10302 include 'COMMON.GEO'
10303 include 'COMMON.VAR'
10304 include 'COMMON.LOCAL'
10305 include 'COMMON.CHAIN'
10306 include 'COMMON.DERIV'
10307 include 'COMMON.NAMES'
10308 include 'COMMON.INTERACT'
10309 include 'COMMON.IOUNITS'
10310 include 'COMMON.CALC'
10311 include 'COMMON.CONTROL'
10312 include 'COMMON.SPLITELE'
10313 include 'COMMON.SBRIDGE'
10315 C Only for check grad COMMENT if not used for checkgrad
10317 C--------------------------------------------------------
10318 C print *,"wchodze"
10322 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10323 dist=dist+diffafm(i)**2
10326 Eafmforce=0.5d0*forceAFMconst
10327 & *(distafminit+totTafm*velAFMconst-dist)**2
10328 C Eafmforce=-forceAFMconst*(dist-distafminit)
10330 gradafm(i,afmend-1)=-forceAFMconst*
10331 &(distafminit+totTafm*velAFMconst-dist)
10333 gradafm(i,afmbeg-1)=forceAFMconst*
10334 &(distafminit+totTafm*velAFMconst-dist)
10337 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist