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 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)
2722 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2723 iti = itortyp(itype(i-2))
2727 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2728 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2729 iti1 = itortyp(itype(i-1))
2737 b1tilde(1,i-2)=b1(1,i-2)
2738 b1tilde(2,i-2)=-b1(2,i-2)
2739 b2tilde(1,i-2)=b2(1,i-2)
2740 b2tilde(2,i-2)=-b2(2,i-2)
2741 EE(1,2,i-2)=eeold(1,2,iti)
2742 EE(2,1,i-2)=eeold(2,1,iti)
2743 EE(2,2,i-2)=eeold(2,2,iti)
2744 EE(1,1,i-2)=eeold(1,1,iti)
2748 do i=ivec_start+2,ivec_end+2
2752 if (i .lt. nres+1) then
2789 if (i .gt. 3 .and. i .lt. nres+1) then
2790 obrot_der(1,i-2)=-sin1
2791 obrot_der(2,i-2)= cos1
2792 Ugder(1,1,i-2)= sin1
2793 Ugder(1,2,i-2)=-cos1
2794 Ugder(2,1,i-2)=-cos1
2795 Ugder(2,2,i-2)=-sin1
2798 obrot2_der(1,i-2)=-dwasin2
2799 obrot2_der(2,i-2)= dwacos2
2800 Ug2der(1,1,i-2)= dwasin2
2801 Ug2der(1,2,i-2)=-dwacos2
2802 Ug2der(2,1,i-2)=-dwacos2
2803 Ug2der(2,2,i-2)=-dwasin2
2805 obrot_der(1,i-2)=0.0d0
2806 obrot_der(2,i-2)=0.0d0
2807 Ugder(1,1,i-2)=0.0d0
2808 Ugder(1,2,i-2)=0.0d0
2809 Ugder(2,1,i-2)=0.0d0
2810 Ugder(2,2,i-2)=0.0d0
2811 obrot2_der(1,i-2)=0.0d0
2812 obrot2_der(2,i-2)=0.0d0
2813 Ug2der(1,1,i-2)=0.0d0
2814 Ug2der(1,2,i-2)=0.0d0
2815 Ug2der(2,1,i-2)=0.0d0
2816 Ug2der(2,2,i-2)=0.0d0
2818 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2819 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2820 iti = itortyp(itype(i-2))
2824 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2825 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2826 iti1 = itortyp(itype(i-1))
2830 cd write (iout,*) '*******i',i,' iti1',iti
2831 cd write (iout,*) 'b1',b1(:,iti)
2832 cd write (iout,*) 'b2',b2(:,iti)
2833 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2834 c if (i .gt. iatel_s+2) then
2835 if (i .gt. nnt+2) then
2836 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2838 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2839 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2841 c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
2842 c & EE(1,2,iti),EE(2,2,iti)
2843 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2844 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2845 c write(iout,*) "Macierz EUG",
2846 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2848 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2850 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2851 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2852 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2853 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2854 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2865 DtUg2(l,k,i-2)=0.0d0
2869 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2870 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2872 muder(k,i-2)=Ub2der(k,i-2)
2874 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2875 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2876 if (itype(i-1).le.ntyp) then
2877 iti1 = itortyp(itype(i-1))
2885 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2887 C write (iout,*) 'mumu',i,b1(1,i-1),Ub2(1,i-2)
2888 c write (iout,*) 'mu ',mu(:,i-2),i-2
2889 cd write (iout,*) 'mu1',mu1(:,i-2)
2890 cd write (iout,*) 'mu2',mu2(:,i-2)
2891 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2893 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2894 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2895 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2896 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2897 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2898 C Vectors and matrices dependent on a single virtual-bond dihedral.
2899 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
2900 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2901 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2902 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2903 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2904 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2905 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2906 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2907 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2910 C Matrices dependent on two consecutive virtual-bond dihedrals.
2911 C The order of matrices is from left to right.
2912 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2914 c do i=max0(ivec_start,2),ivec_end
2916 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2917 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2918 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2919 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2920 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2921 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2922 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2923 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2926 #if defined(MPI) && defined(PARMAT)
2928 c if (fg_rank.eq.0) then
2929 write (iout,*) "Arrays UG and UGDER before GATHER"
2931 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2932 & ((ug(l,k,i),l=1,2),k=1,2),
2933 & ((ugder(l,k,i),l=1,2),k=1,2)
2935 write (iout,*) "Arrays UG2 and UG2DER"
2937 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2938 & ((ug2(l,k,i),l=1,2),k=1,2),
2939 & ((ug2der(l,k,i),l=1,2),k=1,2)
2941 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2943 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2944 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2945 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2947 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2949 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2950 & costab(i),sintab(i),costab2(i),sintab2(i)
2952 write (iout,*) "Array MUDER"
2954 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2958 if (nfgtasks.gt.1) then
2960 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2961 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2962 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2964 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2965 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2967 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2968 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2970 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2971 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2973 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2974 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2976 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2977 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2979 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2980 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2982 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2983 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2984 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2985 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2986 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2987 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2988 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2989 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2990 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2991 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2992 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2993 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2994 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2996 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2997 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2999 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
3000 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3002 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
3003 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3005 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
3006 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3008 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
3009 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3011 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
3012 & ivec_count(fg_rank1),
3013 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3015 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
3016 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3018 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
3019 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3021 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
3022 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3024 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
3025 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3027 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
3028 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3030 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
3031 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3033 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
3034 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3036 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
3037 & ivec_count(fg_rank1),
3038 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3040 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
3041 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3043 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
3044 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3046 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
3047 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3049 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
3050 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3052 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
3053 & ivec_count(fg_rank1),
3054 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3056 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
3057 & ivec_count(fg_rank1),
3058 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3060 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
3061 & ivec_count(fg_rank1),
3062 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3063 & MPI_MAT2,FG_COMM1,IERR)
3064 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
3065 & ivec_count(fg_rank1),
3066 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3067 & MPI_MAT2,FG_COMM1,IERR)
3070 c Passes matrix info through the ring
3073 if (irecv.lt.0) irecv=nfgtasks1-1
3076 if (inext.ge.nfgtasks1) inext=0
3078 c write (iout,*) "isend",isend," irecv",irecv
3080 lensend=lentyp(isend)
3081 lenrecv=lentyp(irecv)
3082 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
3083 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3084 c & MPI_ROTAT1(lensend),inext,2200+isend,
3085 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3086 c & iprev,2200+irecv,FG_COMM,status,IERR)
3087 c write (iout,*) "Gather ROTAT1"
3089 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3090 c & MPI_ROTAT2(lensend),inext,3300+isend,
3091 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3092 c & iprev,3300+irecv,FG_COMM,status,IERR)
3093 c write (iout,*) "Gather ROTAT2"
3095 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
3096 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
3097 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
3098 & iprev,4400+irecv,FG_COMM,status,IERR)
3099 c write (iout,*) "Gather ROTAT_OLD"
3101 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
3102 & MPI_PRECOMP11(lensend),inext,5500+isend,
3103 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
3104 & iprev,5500+irecv,FG_COMM,status,IERR)
3105 c write (iout,*) "Gather PRECOMP11"
3107 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
3108 & MPI_PRECOMP12(lensend),inext,6600+isend,
3109 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
3110 & iprev,6600+irecv,FG_COMM,status,IERR)
3111 c write (iout,*) "Gather PRECOMP12"
3113 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3115 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
3116 & MPI_ROTAT2(lensend),inext,7700+isend,
3117 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3118 & iprev,7700+irecv,FG_COMM,status,IERR)
3119 c write (iout,*) "Gather PRECOMP21"
3121 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
3122 & MPI_PRECOMP22(lensend),inext,8800+isend,
3123 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
3124 & iprev,8800+irecv,FG_COMM,status,IERR)
3125 c write (iout,*) "Gather PRECOMP22"
3127 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
3128 & MPI_PRECOMP23(lensend),inext,9900+isend,
3129 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
3130 & MPI_PRECOMP23(lenrecv),
3131 & iprev,9900+irecv,FG_COMM,status,IERR)
3132 c write (iout,*) "Gather PRECOMP23"
3137 if (irecv.lt.0) irecv=nfgtasks1-1
3140 time_gather=time_gather+MPI_Wtime()-time00
3143 c if (fg_rank.eq.0) then
3144 write (iout,*) "Arrays UG and UGDER"
3146 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3147 & ((ug(l,k,i),l=1,2),k=1,2),
3148 & ((ugder(l,k,i),l=1,2),k=1,2)
3150 write (iout,*) "Arrays UG2 and UG2DER"
3152 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3153 & ((ug2(l,k,i),l=1,2),k=1,2),
3154 & ((ug2der(l,k,i),l=1,2),k=1,2)
3156 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3158 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3159 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3160 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3162 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3164 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3165 & costab(i),sintab(i),costab2(i),sintab2(i)
3167 write (iout,*) "Array MUDER"
3169 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3175 cd iti = itortyp(itype(i))
3178 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3179 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3184 C--------------------------------------------------------------------------
3185 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3187 C This subroutine calculates the average interaction energy and its gradient
3188 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3189 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3190 C The potential depends both on the distance of peptide-group centers and on
3191 C the orientation of the CA-CA virtual bonds.
3193 implicit real*8 (a-h,o-z)
3197 include 'DIMENSIONS'
3198 include 'COMMON.CONTROL'
3199 include 'COMMON.SETUP'
3200 include 'COMMON.IOUNITS'
3201 include 'COMMON.GEO'
3202 include 'COMMON.VAR'
3203 include 'COMMON.LOCAL'
3204 include 'COMMON.CHAIN'
3205 include 'COMMON.DERIV'
3206 include 'COMMON.INTERACT'
3207 include 'COMMON.CONTACTS'
3208 include 'COMMON.TORSION'
3209 include 'COMMON.VECTORS'
3210 include 'COMMON.FFIELD'
3211 include 'COMMON.TIME1'
3212 include 'COMMON.SPLITELE'
3213 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3214 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3215 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3216 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3217 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3218 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3220 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3222 double precision scal_el /1.0d0/
3224 double precision scal_el /0.5d0/
3227 C 13-go grudnia roku pamietnego...
3228 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3229 & 0.0d0,1.0d0,0.0d0,
3230 & 0.0d0,0.0d0,1.0d0/
3231 cd write(iout,*) 'In EELEC'
3233 cd write(iout,*) 'Type',i
3234 cd write(iout,*) 'B1',B1(:,i)
3235 cd write(iout,*) 'B2',B2(:,i)
3236 cd write(iout,*) 'CC',CC(:,:,i)
3237 cd write(iout,*) 'DD',DD(:,:,i)
3238 cd write(iout,*) 'EE',EE(:,:,i)
3240 cd call check_vecgrad
3242 if (icheckgrad.eq.1) then
3244 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3246 dc_norm(k,i)=dc(k,i)*fac
3248 c write (iout,*) 'i',i,' fac',fac
3251 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3252 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3253 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3254 c call vec_and_deriv
3260 time_mat=time_mat+MPI_Wtime()-time01
3264 cd write (iout,*) 'i=',i
3266 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3269 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3270 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3283 cd print '(a)','Enter EELEC'
3284 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3286 gel_loc_loc(i)=0.0d0
3291 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3293 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3295 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3296 do i=iturn3_start,iturn3_end
3298 C write(iout,*) "tu jest i",i
3299 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3300 C changes suggested by Ana to avoid out of bounds
3301 & .or.((i+4).gt.nres)
3303 C end of changes by Ana
3304 & .or. itype(i+2).eq.ntyp1
3305 & .or. itype(i+3).eq.ntyp1) cycle
3307 if(itype(i-1).eq.ntyp1)cycle
3310 if (itype(i+4).eq.ntyp1) cycle
3315 dx_normi=dc_norm(1,i)
3316 dy_normi=dc_norm(2,i)
3317 dz_normi=dc_norm(3,i)
3318 xmedi=c(1,i)+0.5d0*dxi
3319 ymedi=c(2,i)+0.5d0*dyi
3320 zmedi=c(3,i)+0.5d0*dzi
3321 xmedi=mod(xmedi,boxxsize)
3322 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3323 ymedi=mod(ymedi,boxysize)
3324 if (ymedi.lt.0) ymedi=ymedi+boxysize
3325 zmedi=mod(zmedi,boxzsize)
3326 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3328 call eelecij(i,i+2,ees,evdw1,eel_loc)
3329 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3330 num_cont_hb(i)=num_conti
3332 do i=iturn4_start,iturn4_end
3334 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3335 C changes suggested by Ana to avoid out of bounds
3336 & .or.((i+5).gt.nres)
3338 C end of changes suggested by Ana
3339 & .or. itype(i+3).eq.ntyp1
3340 & .or. itype(i+4).eq.ntyp1
3341 & .or. itype(i+5).eq.ntyp1
3342 & .or. itype(i).eq.ntyp1
3343 & .or. itype(i-1).eq.ntyp1
3348 dx_normi=dc_norm(1,i)
3349 dy_normi=dc_norm(2,i)
3350 dz_normi=dc_norm(3,i)
3351 xmedi=c(1,i)+0.5d0*dxi
3352 ymedi=c(2,i)+0.5d0*dyi
3353 zmedi=c(3,i)+0.5d0*dzi
3354 C Return atom into box, boxxsize is size of box in x dimension
3356 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3357 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3358 C Condition for being inside the proper box
3359 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3360 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3364 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3365 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3366 C Condition for being inside the proper box
3367 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3368 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3372 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3373 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3374 C Condition for being inside the proper box
3375 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3376 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3379 xmedi=mod(xmedi,boxxsize)
3380 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3381 ymedi=mod(ymedi,boxysize)
3382 if (ymedi.lt.0) ymedi=ymedi+boxysize
3383 zmedi=mod(zmedi,boxzsize)
3384 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3386 num_conti=num_cont_hb(i)
3387 c write(iout,*) "JESTEM W PETLI"
3388 call eelecij(i,i+3,ees,evdw1,eel_loc)
3389 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3390 & call eturn4(i,eello_turn4)
3391 num_cont_hb(i)=num_conti
3393 C Loop over all neighbouring boxes
3398 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3400 do i=iatel_s,iatel_e
3402 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3403 C changes suggested by Ana to avoid out of bounds
3404 & .or.((i+2).gt.nres)
3406 C end of changes by Ana
3407 & .or. itype(i+2).eq.ntyp1
3408 & .or. itype(i-1).eq.ntyp1
3413 dx_normi=dc_norm(1,i)
3414 dy_normi=dc_norm(2,i)
3415 dz_normi=dc_norm(3,i)
3416 xmedi=c(1,i)+0.5d0*dxi
3417 ymedi=c(2,i)+0.5d0*dyi
3418 zmedi=c(3,i)+0.5d0*dzi
3419 xmedi=mod(xmedi,boxxsize)
3420 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3421 ymedi=mod(ymedi,boxysize)
3422 if (ymedi.lt.0) ymedi=ymedi+boxysize
3423 zmedi=mod(zmedi,boxzsize)
3424 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3425 C xmedi=xmedi+xshift*boxxsize
3426 C ymedi=ymedi+yshift*boxysize
3427 C zmedi=zmedi+zshift*boxzsize
3429 C Return tom into box, boxxsize is size of box in x dimension
3431 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3432 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3433 C Condition for being inside the proper box
3434 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3435 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3439 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3440 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3441 C Condition for being inside the proper box
3442 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3443 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3447 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3448 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3449 cC Condition for being inside the proper box
3450 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3451 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3455 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3456 num_conti=num_cont_hb(i)
3457 do j=ielstart(i),ielend(i)
3458 C write (iout,*) i,j
3460 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3461 C changes suggested by Ana to avoid out of bounds
3462 & .or.((j+2).gt.nres)
3464 C end of changes by Ana
3465 & .or.itype(j+2).eq.ntyp1
3466 & .or.itype(j-1).eq.ntyp1
3468 call eelecij(i,j,ees,evdw1,eel_loc)
3470 num_cont_hb(i)=num_conti
3476 c write (iout,*) "Number of loop steps in EELEC:",ind
3478 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3479 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3481 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3482 ccc eel_loc=eel_loc+eello_turn3
3483 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3486 C-------------------------------------------------------------------------------
3487 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3488 implicit real*8 (a-h,o-z)
3489 include 'DIMENSIONS'
3493 include 'COMMON.CONTROL'
3494 include 'COMMON.IOUNITS'
3495 include 'COMMON.GEO'
3496 include 'COMMON.VAR'
3497 include 'COMMON.LOCAL'
3498 include 'COMMON.CHAIN'
3499 include 'COMMON.DERIV'
3500 include 'COMMON.INTERACT'
3501 include 'COMMON.CONTACTS'
3502 include 'COMMON.TORSION'
3503 include 'COMMON.VECTORS'
3504 include 'COMMON.FFIELD'
3505 include 'COMMON.TIME1'
3506 include 'COMMON.SPLITELE'
3507 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3508 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3509 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3510 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3511 & gmuij2(4),gmuji2(4)
3512 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3513 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3515 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3517 double precision scal_el /1.0d0/
3519 double precision scal_el /0.5d0/
3522 C 13-go grudnia roku pamietnego...
3523 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3524 & 0.0d0,1.0d0,0.0d0,
3525 & 0.0d0,0.0d0,1.0d0/
3526 c time00=MPI_Wtime()
3527 cd write (iout,*) "eelecij",i,j
3531 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3532 aaa=app(iteli,itelj)
3533 bbb=bpp(iteli,itelj)
3534 ael6i=ael6(iteli,itelj)
3535 ael3i=ael3(iteli,itelj)
3539 dx_normj=dc_norm(1,j)
3540 dy_normj=dc_norm(2,j)
3541 dz_normj=dc_norm(3,j)
3542 C xj=c(1,j)+0.5D0*dxj-xmedi
3543 C yj=c(2,j)+0.5D0*dyj-ymedi
3544 C zj=c(3,j)+0.5D0*dzj-zmedi
3549 if (xj.lt.0) xj=xj+boxxsize
3551 if (yj.lt.0) yj=yj+boxysize
3553 if (zj.lt.0) zj=zj+boxzsize
3554 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3555 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3563 xj=xj_safe+xshift*boxxsize
3564 yj=yj_safe+yshift*boxysize
3565 zj=zj_safe+zshift*boxzsize
3566 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3567 if(dist_temp.lt.dist_init) then
3577 if (isubchap.eq.1) then
3586 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3588 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3589 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3590 C Condition for being inside the proper box
3591 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3592 c & (xj.lt.((-0.5d0)*boxxsize))) then
3596 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3597 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3598 C Condition for being inside the proper box
3599 c if ((yj.gt.((0.5d0)*boxysize)).or.
3600 c & (yj.lt.((-0.5d0)*boxysize))) then
3604 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3605 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3606 C Condition for being inside the proper box
3607 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3608 c & (zj.lt.((-0.5d0)*boxzsize))) then
3611 C endif !endPBC condintion
3615 rij=xj*xj+yj*yj+zj*zj
3617 sss=sscale(sqrt(rij))
3618 sssgrad=sscagrad(sqrt(rij))
3619 c if (sss.gt.0.0d0) then
3625 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3626 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3627 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3628 fac=cosa-3.0D0*cosb*cosg
3630 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3631 if (j.eq.i+2) ev1=scal_el*ev1
3636 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3640 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3641 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3643 evdw1=evdw1+evdwij*sss
3644 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3645 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3646 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3647 cd & xmedi,ymedi,zmedi,xj,yj,zj
3649 if (energy_dec) then
3650 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3652 &,iteli,itelj,aaa,evdw1
3653 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3657 C Calculate contributions to the Cartesian gradient.
3660 facvdw=-6*rrmij*(ev1+evdwij)*sss
3661 facel=-3*rrmij*(el1+eesij)
3667 * Radial derivatives. First process both termini of the fragment (i,j)
3673 c ghalf=0.5D0*ggg(k)
3674 c gelc(k,i)=gelc(k,i)+ghalf
3675 c gelc(k,j)=gelc(k,j)+ghalf
3677 c 9/28/08 AL Gradient compotents will be summed only at the end
3679 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3680 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3683 * Loop over residues i+1 thru j-1.
3687 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3690 if (sss.gt.0.0) then
3691 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3692 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3693 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3700 c ghalf=0.5D0*ggg(k)
3701 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3702 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3704 c 9/28/08 AL Gradient compotents will be summed only at the end
3706 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3707 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3710 * Loop over residues i+1 thru j-1.
3714 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3719 facvdw=(ev1+evdwij)*sss
3722 fac=-3*rrmij*(facvdw+facvdw+facel)
3727 * Radial derivatives. First process both termini of the fragment (i,j)
3733 c ghalf=0.5D0*ggg(k)
3734 c gelc(k,i)=gelc(k,i)+ghalf
3735 c gelc(k,j)=gelc(k,j)+ghalf
3737 c 9/28/08 AL Gradient compotents will be summed only at the end
3739 gelc_long(k,j)=gelc(k,j)+ggg(k)
3740 gelc_long(k,i)=gelc(k,i)-ggg(k)
3743 * Loop over residues i+1 thru j-1.
3747 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3750 c 9/28/08 AL Gradient compotents will be summed only at the end
3751 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3752 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3753 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3755 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3756 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3762 ecosa=2.0D0*fac3*fac1+fac4
3765 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3766 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3768 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3769 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3771 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3772 cd & (dcosg(k),k=1,3)
3774 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3777 c ghalf=0.5D0*ggg(k)
3778 c gelc(k,i)=gelc(k,i)+ghalf
3779 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3780 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3781 c gelc(k,j)=gelc(k,j)+ghalf
3782 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3783 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3787 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3792 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3793 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3795 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3796 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3797 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3798 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3802 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3803 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3804 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3806 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3807 C energy of a peptide unit is assumed in the form of a second-order
3808 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3809 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3810 C are computed for EVERY pair of non-contiguous peptide groups.
3813 if (j.lt.nres-1) then
3825 muij(kkk)=mu(k,i)*mu(l,j)
3826 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
3828 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
3829 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
3830 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
3831 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
3832 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
3833 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
3837 cd write (iout,*) 'EELEC: i',i,' j',j
3838 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3839 cd write(iout,*) 'muij',muij
3840 ury=scalar(uy(1,i),erij)
3841 urz=scalar(uz(1,i),erij)
3842 vry=scalar(uy(1,j),erij)
3843 vrz=scalar(uz(1,j),erij)
3844 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3845 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3846 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3847 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3848 fac=dsqrt(-ael6i)*r3ij
3853 cd write (iout,'(4i5,4f10.5)')
3854 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3855 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3856 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3857 cd & uy(:,j),uz(:,j)
3858 cd write (iout,'(4f10.5)')
3859 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3860 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3861 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3862 cd write (iout,'(9f10.5/)')
3863 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3864 C Derivatives of the elements of A in virtual-bond vectors
3865 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3867 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3868 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3869 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3870 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3871 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3872 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3873 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3874 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3875 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3876 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3877 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3878 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3880 C Compute radial contributions to the gradient
3898 C Add the contributions coming from er
3901 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3902 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3903 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3904 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3907 C Derivatives in DC(i)
3908 cgrad ghalf1=0.5d0*agg(k,1)
3909 cgrad ghalf2=0.5d0*agg(k,2)
3910 cgrad ghalf3=0.5d0*agg(k,3)
3911 cgrad ghalf4=0.5d0*agg(k,4)
3912 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3913 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3914 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3915 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3916 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3917 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3918 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3919 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3920 C Derivatives in DC(i+1)
3921 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3922 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3923 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3924 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3925 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3926 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3927 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3928 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3929 C Derivatives in DC(j)
3930 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3931 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3932 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3933 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3934 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3935 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3936 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3937 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3938 C Derivatives in DC(j+1) or DC(nres-1)
3939 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3940 & -3.0d0*vryg(k,3)*ury)
3941 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3942 & -3.0d0*vrzg(k,3)*ury)
3943 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3944 & -3.0d0*vryg(k,3)*urz)
3945 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3946 & -3.0d0*vrzg(k,3)*urz)
3947 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3949 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
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)
3968 if (j.lt.nres-1) then
3974 aggi(k,l)=-aggi(k,l)
3975 aggi1(k,l)=-aggi1(k,l)
3976 aggj(k,l)=-aggj(k,l)
3977 aggj1(k,l)=-aggj1(k,l)
3988 aggi(k,l)=-aggi(k,l)
3989 aggi1(k,l)=-aggi1(k,l)
3990 aggj(k,l)=-aggj(k,l)
3991 aggj1(k,l)=-aggj1(k,l)
3996 IF (wel_loc.gt.0.0d0) THEN
3997 C Contribution to the local-electrostatic energy coming from the i-j pair
3998 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
4000 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
4001 c & ' eel_loc_ij',eel_loc_ij
4002 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
4003 C Calculate patrial derivative for theta angle
4005 geel_loc_ij=a22*gmuij1(1)
4009 c write(iout,*) "derivative over thatai"
4010 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4012 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
4013 & geel_loc_ij*wel_loc
4014 c write(iout,*) "derivative over thatai-1"
4015 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4022 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4023 & geel_loc_ij*wel_loc
4024 c Derivative over j residue
4025 geel_loc_ji=a22*gmuji1(1)
4029 c write(iout,*) "derivative over thataj"
4030 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4033 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4034 & geel_loc_ji*wel_loc
4040 c write(iout,*) "derivative over thataj-1"
4041 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4043 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4044 & geel_loc_ji*wel_loc
4046 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4048 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4049 & 'eelloc',i,j,eel_loc_ij
4050 c if (eel_loc_ij.ne.0)
4051 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4052 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4054 eel_loc=eel_loc+eel_loc_ij
4055 C Partial derivatives in virtual-bond dihedral angles gamma
4057 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4058 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4059 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
4060 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4061 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4062 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
4063 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4065 ggg(l)=agg(l,1)*muij(1)+
4066 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
4067 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4068 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4069 cgrad ghalf=0.5d0*ggg(l)
4070 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4071 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4075 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4078 C Remaining derivatives of eello
4080 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4081 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4082 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4083 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4084 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4085 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4086 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4087 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4090 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4091 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4092 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4093 & .and. num_conti.le.maxconts) then
4094 c write (iout,*) i,j," entered corr"
4096 C Calculate the contact function. The ith column of the array JCONT will
4097 C contain the numbers of atoms that make contacts with the atom I (of numbers
4098 C greater than I). The arrays FACONT and GACONT will contain the values of
4099 C the contact function and its derivative.
4100 c r0ij=1.02D0*rpp(iteli,itelj)
4101 c r0ij=1.11D0*rpp(iteli,itelj)
4102 r0ij=2.20D0*rpp(iteli,itelj)
4103 c r0ij=1.55D0*rpp(iteli,itelj)
4104 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4105 if (fcont.gt.0.0D0) then
4106 num_conti=num_conti+1
4107 if (num_conti.gt.maxconts) then
4108 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4109 & ' will skip next contacts for this conf.'
4111 jcont_hb(num_conti,i)=j
4112 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4113 cd & " jcont_hb",jcont_hb(num_conti,i)
4114 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4115 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4116 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4118 d_cont(num_conti,i)=rij
4119 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4120 C --- Electrostatic-interaction matrix ---
4121 a_chuj(1,1,num_conti,i)=a22
4122 a_chuj(1,2,num_conti,i)=a23
4123 a_chuj(2,1,num_conti,i)=a32
4124 a_chuj(2,2,num_conti,i)=a33
4125 C --- Gradient of rij
4127 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4134 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4135 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4136 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4137 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4138 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4143 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4144 C Calculate contact energies
4146 wij=cosa-3.0D0*cosb*cosg
4149 c fac3=dsqrt(-ael6i)/r0ij**3
4150 fac3=dsqrt(-ael6i)*r3ij
4151 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4152 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4153 if (ees0tmp.gt.0) then
4154 ees0pij=dsqrt(ees0tmp)
4158 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4159 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4160 if (ees0tmp.gt.0) then
4161 ees0mij=dsqrt(ees0tmp)
4166 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4167 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4168 C Diagnostics. Comment out or remove after debugging!
4169 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4170 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4171 c ees0m(num_conti,i)=0.0D0
4173 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4174 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4175 C Angular derivatives of the contact function
4176 ees0pij1=fac3/ees0pij
4177 ees0mij1=fac3/ees0mij
4178 fac3p=-3.0D0*fac3*rrmij
4179 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4180 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4182 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4183 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4184 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4185 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4186 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4187 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4188 ecosap=ecosa1+ecosa2
4189 ecosbp=ecosb1+ecosb2
4190 ecosgp=ecosg1+ecosg2
4191 ecosam=ecosa1-ecosa2
4192 ecosbm=ecosb1-ecosb2
4193 ecosgm=ecosg1-ecosg2
4202 facont_hb(num_conti,i)=fcont
4203 fprimcont=fprimcont/rij
4204 cd facont_hb(num_conti,i)=1.0D0
4205 C Following line is for diagnostics.
4208 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4209 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4212 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4213 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4215 gggp(1)=gggp(1)+ees0pijp*xj
4216 gggp(2)=gggp(2)+ees0pijp*yj
4217 gggp(3)=gggp(3)+ees0pijp*zj
4218 gggm(1)=gggm(1)+ees0mijp*xj
4219 gggm(2)=gggm(2)+ees0mijp*yj
4220 gggm(3)=gggm(3)+ees0mijp*zj
4221 C Derivatives due to the contact function
4222 gacont_hbr(1,num_conti,i)=fprimcont*xj
4223 gacont_hbr(2,num_conti,i)=fprimcont*yj
4224 gacont_hbr(3,num_conti,i)=fprimcont*zj
4227 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4228 c following the change of gradient-summation algorithm.
4230 cgrad ghalfp=0.5D0*gggp(k)
4231 cgrad ghalfm=0.5D0*gggm(k)
4232 gacontp_hb1(k,num_conti,i)=!ghalfp
4233 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4234 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4235 gacontp_hb2(k,num_conti,i)=!ghalfp
4236 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4237 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4238 gacontp_hb3(k,num_conti,i)=gggp(k)
4239 gacontm_hb1(k,num_conti,i)=!ghalfm
4240 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4241 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4242 gacontm_hb2(k,num_conti,i)=!ghalfm
4243 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4244 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4245 gacontm_hb3(k,num_conti,i)=gggm(k)
4247 C Diagnostics. Comment out or remove after debugging!
4249 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4250 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4251 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4252 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4253 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4254 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4257 endif ! num_conti.le.maxconts
4260 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4263 ghalf=0.5d0*agg(l,k)
4264 aggi(l,k)=aggi(l,k)+ghalf
4265 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4266 aggj(l,k)=aggj(l,k)+ghalf
4269 if (j.eq.nres-1 .and. i.lt.j-2) then
4272 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4277 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4280 C-----------------------------------------------------------------------------
4281 subroutine eturn3(i,eello_turn3)
4282 C Third- and fourth-order contributions from turns
4283 implicit real*8 (a-h,o-z)
4284 include 'DIMENSIONS'
4285 include 'COMMON.IOUNITS'
4286 include 'COMMON.GEO'
4287 include 'COMMON.VAR'
4288 include 'COMMON.LOCAL'
4289 include 'COMMON.CHAIN'
4290 include 'COMMON.DERIV'
4291 include 'COMMON.INTERACT'
4292 include 'COMMON.CONTACTS'
4293 include 'COMMON.TORSION'
4294 include 'COMMON.VECTORS'
4295 include 'COMMON.FFIELD'
4296 include 'COMMON.CONTROL'
4298 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4299 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4300 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4301 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4302 & auxgmat2(2,2),auxgmatt2(2,2)
4303 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4304 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4305 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4306 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4309 c write (iout,*) "eturn3",i,j,j1,j2
4314 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4316 C Third-order contributions
4323 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4324 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4325 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4326 c auxalary matices for theta gradient
4327 c auxalary matrix for i+1 and constant i+2
4328 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4329 c auxalary matrix for i+2 and constant i+1
4330 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4331 call transpose2(auxmat(1,1),auxmat1(1,1))
4332 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4333 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4334 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4335 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4336 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4337 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4338 C Derivatives in theta
4339 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4340 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4341 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4342 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4344 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4345 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4346 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4347 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4348 cd & ' eello_turn3_num',4*eello_turn3_num
4349 C Derivatives in gamma(i)
4350 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4351 call transpose2(auxmat2(1,1),auxmat3(1,1))
4352 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4353 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4354 C Derivatives in gamma(i+1)
4355 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4356 call transpose2(auxmat2(1,1),auxmat3(1,1))
4357 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4358 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4359 & +0.5d0*(pizda(1,1)+pizda(2,2))
4360 C Cartesian derivatives
4362 c ghalf1=0.5d0*agg(l,1)
4363 c ghalf2=0.5d0*agg(l,2)
4364 c ghalf3=0.5d0*agg(l,3)
4365 c ghalf4=0.5d0*agg(l,4)
4366 a_temp(1,1)=aggi(l,1)!+ghalf1
4367 a_temp(1,2)=aggi(l,2)!+ghalf2
4368 a_temp(2,1)=aggi(l,3)!+ghalf3
4369 a_temp(2,2)=aggi(l,4)!+ghalf4
4370 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4371 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4372 & +0.5d0*(pizda(1,1)+pizda(2,2))
4373 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4374 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4375 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4376 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4377 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4378 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4379 & +0.5d0*(pizda(1,1)+pizda(2,2))
4380 a_temp(1,1)=aggj(l,1)!+ghalf1
4381 a_temp(1,2)=aggj(l,2)!+ghalf2
4382 a_temp(2,1)=aggj(l,3)!+ghalf3
4383 a_temp(2,2)=aggj(l,4)!+ghalf4
4384 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4385 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4386 & +0.5d0*(pizda(1,1)+pizda(2,2))
4387 a_temp(1,1)=aggj1(l,1)
4388 a_temp(1,2)=aggj1(l,2)
4389 a_temp(2,1)=aggj1(l,3)
4390 a_temp(2,2)=aggj1(l,4)
4391 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4392 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4393 & +0.5d0*(pizda(1,1)+pizda(2,2))
4397 C-------------------------------------------------------------------------------
4398 subroutine eturn4(i,eello_turn4)
4399 C Third- and fourth-order contributions from turns
4400 implicit real*8 (a-h,o-z)
4401 include 'DIMENSIONS'
4402 include 'COMMON.IOUNITS'
4403 include 'COMMON.GEO'
4404 include 'COMMON.VAR'
4405 include 'COMMON.LOCAL'
4406 include 'COMMON.CHAIN'
4407 include 'COMMON.DERIV'
4408 include 'COMMON.INTERACT'
4409 include 'COMMON.CONTACTS'
4410 include 'COMMON.TORSION'
4411 include 'COMMON.VECTORS'
4412 include 'COMMON.FFIELD'
4413 include 'COMMON.CONTROL'
4415 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4416 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4417 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4418 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4419 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4420 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4421 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4422 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4423 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4424 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4425 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4428 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4430 C Fourth-order contributions
4438 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4439 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4440 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4441 c write(iout,*)"WCHODZE W PROGRAM"
4446 iti1=itortyp(itype(i+1))
4447 iti2=itortyp(itype(i+2))
4448 iti3=itortyp(itype(i+3))
4449 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4450 call transpose2(EUg(1,1,i+1),e1t(1,1))
4451 call transpose2(Eug(1,1,i+2),e2t(1,1))
4452 call transpose2(Eug(1,1,i+3),e3t(1,1))
4453 C Ematrix derivative in theta
4454 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4455 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4456 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4457 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4458 c eta1 in derivative theta
4459 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4460 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4461 c auxgvec is derivative of Ub2 so i+3 theta
4462 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4463 c auxalary matrix of E i+1
4464 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4467 s1=scalar2(b1(1,i+2),auxvec(1))
4468 c derivative of theta i+2 with constant i+3
4469 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4470 c derivative of theta i+2 with constant i+2
4471 gs32=scalar2(b1(1,i+2),auxgvec(1))
4472 c derivative of E matix in theta of i+1
4473 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4475 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4476 c ea31 in derivative theta
4477 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4478 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4479 c auxilary matrix auxgvec of Ub2 with constant E matirx
4480 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4481 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4482 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4486 s2=scalar2(b1(1,i+1),auxvec(1))
4487 c derivative of theta i+1 with constant i+3
4488 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4489 c derivative of theta i+2 with constant i+1
4490 gs21=scalar2(b1(1,i+1),auxgvec(1))
4491 c derivative of theta i+3 with constant i+1
4492 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4493 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4495 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4496 c two derivatives over diffetent matrices
4497 c gtae3e2 is derivative over i+3
4498 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4499 c ae3gte2 is derivative over i+2
4500 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4501 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4502 c three possible derivative over theta E matices
4504 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4506 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4508 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4509 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4511 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4512 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4513 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4515 eello_turn4=eello_turn4-(s1+s2+s3)
4516 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4517 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4518 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4519 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4520 cd & ' eello_turn4_num',8*eello_turn4_num
4522 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4523 & -(gs13+gsE13+gsEE1)*wturn4
4524 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
4525 & -(gs23+gs21+gsEE2)*wturn4
4526 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
4527 & -(gs32+gsE31+gsEE3)*wturn4
4528 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
4531 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4532 & 'eturn4',i,j,-(s1+s2+s3)
4533 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4534 c & ' eello_turn4_num',8*eello_turn4_num
4535 C Derivatives in gamma(i)
4536 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4537 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4538 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4539 s1=scalar2(b1(1,i+2),auxvec(1))
4540 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4541 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4542 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4543 C Derivatives in gamma(i+1)
4544 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4545 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4546 s2=scalar2(b1(1,i+1),auxvec(1))
4547 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4548 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4549 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4550 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4551 C Derivatives in gamma(i+2)
4552 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4553 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4554 s1=scalar2(b1(1,i+2),auxvec(1))
4555 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4556 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4557 s2=scalar2(b1(1,i+1),auxvec(1))
4558 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4559 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4560 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4561 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4562 C Cartesian derivatives
4563 C Derivatives of this turn contributions in DC(i+2)
4564 if (j.lt.nres-1) then
4566 a_temp(1,1)=agg(l,1)
4567 a_temp(1,2)=agg(l,2)
4568 a_temp(2,1)=agg(l,3)
4569 a_temp(2,2)=agg(l,4)
4570 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4571 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4572 s1=scalar2(b1(1,i+2),auxvec(1))
4573 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4574 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4575 s2=scalar2(b1(1,i+1),auxvec(1))
4576 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4577 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4578 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4580 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4583 C Remaining derivatives of this turn contribution
4585 a_temp(1,1)=aggi(l,1)
4586 a_temp(1,2)=aggi(l,2)
4587 a_temp(2,1)=aggi(l,3)
4588 a_temp(2,2)=aggi(l,4)
4589 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4590 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4591 s1=scalar2(b1(1,i+2),auxvec(1))
4592 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4593 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4594 s2=scalar2(b1(1,i+1),auxvec(1))
4595 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4596 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4597 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4598 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4599 a_temp(1,1)=aggi1(l,1)
4600 a_temp(1,2)=aggi1(l,2)
4601 a_temp(2,1)=aggi1(l,3)
4602 a_temp(2,2)=aggi1(l,4)
4603 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4604 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4605 s1=scalar2(b1(1,i+2),auxvec(1))
4606 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4607 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4608 s2=scalar2(b1(1,i+1),auxvec(1))
4609 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4610 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4611 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4612 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4613 a_temp(1,1)=aggj(l,1)
4614 a_temp(1,2)=aggj(l,2)
4615 a_temp(2,1)=aggj(l,3)
4616 a_temp(2,2)=aggj(l,4)
4617 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4618 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4619 s1=scalar2(b1(1,i+2),auxvec(1))
4620 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4621 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4622 s2=scalar2(b1(1,i+1),auxvec(1))
4623 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4624 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4625 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4626 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4627 a_temp(1,1)=aggj1(l,1)
4628 a_temp(1,2)=aggj1(l,2)
4629 a_temp(2,1)=aggj1(l,3)
4630 a_temp(2,2)=aggj1(l,4)
4631 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4632 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4633 s1=scalar2(b1(1,i+2),auxvec(1))
4634 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4635 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4636 s2=scalar2(b1(1,i+1),auxvec(1))
4637 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4638 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4639 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4640 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4641 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4645 C-----------------------------------------------------------------------------
4646 subroutine vecpr(u,v,w)
4647 implicit real*8(a-h,o-z)
4648 dimension u(3),v(3),w(3)
4649 w(1)=u(2)*v(3)-u(3)*v(2)
4650 w(2)=-u(1)*v(3)+u(3)*v(1)
4651 w(3)=u(1)*v(2)-u(2)*v(1)
4654 C-----------------------------------------------------------------------------
4655 subroutine unormderiv(u,ugrad,unorm,ungrad)
4656 C This subroutine computes the derivatives of a normalized vector u, given
4657 C the derivatives computed without normalization conditions, ugrad. Returns
4660 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4661 double precision vec(3)
4662 double precision scalar
4664 c write (2,*) 'ugrad',ugrad
4667 vec(i)=scalar(ugrad(1,i),u(1))
4669 c write (2,*) 'vec',vec
4672 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4675 c write (2,*) 'ungrad',ungrad
4678 C-----------------------------------------------------------------------------
4679 subroutine escp_soft_sphere(evdw2,evdw2_14)
4681 C This subroutine calculates the excluded-volume interaction energy between
4682 C peptide-group centers and side chains and its gradient in virtual-bond and
4683 C side-chain vectors.
4685 implicit real*8 (a-h,o-z)
4686 include 'DIMENSIONS'
4687 include 'COMMON.GEO'
4688 include 'COMMON.VAR'
4689 include 'COMMON.LOCAL'
4690 include 'COMMON.CHAIN'
4691 include 'COMMON.DERIV'
4692 include 'COMMON.INTERACT'
4693 include 'COMMON.FFIELD'
4694 include 'COMMON.IOUNITS'
4695 include 'COMMON.CONTROL'
4700 cd print '(a)','Enter ESCP'
4701 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4705 do i=iatscp_s,iatscp_e
4706 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4708 xi=0.5D0*(c(1,i)+c(1,i+1))
4709 yi=0.5D0*(c(2,i)+c(2,i+1))
4710 zi=0.5D0*(c(3,i)+c(3,i+1))
4711 C Return atom into box, boxxsize is size of box in x dimension
4713 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4714 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4715 C Condition for being inside the proper box
4716 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4717 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4721 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4722 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4723 C Condition for being inside the proper box
4724 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4725 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4729 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4730 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4731 cC Condition for being inside the proper box
4732 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4733 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4737 if (xi.lt.0) xi=xi+boxxsize
4739 if (yi.lt.0) yi=yi+boxysize
4741 if (zi.lt.0) zi=zi+boxzsize
4742 C xi=xi+xshift*boxxsize
4743 C yi=yi+yshift*boxysize
4744 C zi=zi+zshift*boxzsize
4745 do iint=1,nscp_gr(i)
4747 do j=iscpstart(i,iint),iscpend(i,iint)
4748 if (itype(j).eq.ntyp1) cycle
4749 itypj=iabs(itype(j))
4750 C Uncomment following three lines for SC-p interactions
4754 C Uncomment following three lines for Ca-p interactions
4759 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4760 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4761 C Condition for being inside the proper box
4762 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4763 c & (xj.lt.((-0.5d0)*boxxsize))) then
4767 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4768 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4769 cC Condition for being inside the proper box
4770 c if ((yj.gt.((0.5d0)*boxysize)).or.
4771 c & (yj.lt.((-0.5d0)*boxysize))) then
4775 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4776 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4777 C Condition for being inside the proper box
4778 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4779 c & (zj.lt.((-0.5d0)*boxzsize))) then
4782 if (xj.lt.0) xj=xj+boxxsize
4784 if (yj.lt.0) yj=yj+boxysize
4786 if (zj.lt.0) zj=zj+boxzsize
4787 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4795 xj=xj_safe+xshift*boxxsize
4796 yj=yj_safe+yshift*boxysize
4797 zj=zj_safe+zshift*boxzsize
4798 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4799 if(dist_temp.lt.dist_init) then
4809 if (subchap.eq.1) then
4822 rij=xj*xj+yj*yj+zj*zj
4826 if (rij.lt.r0ijsq) then
4827 evdwij=0.25d0*(rij-r0ijsq)**2
4835 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4840 cgrad if (j.lt.i) then
4841 cd write (iout,*) 'j<i'
4842 C Uncomment following three lines for SC-p interactions
4844 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4847 cd write (iout,*) 'j>i'
4849 cgrad ggg(k)=-ggg(k)
4850 C Uncomment following line for SC-p interactions
4851 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4855 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4857 cgrad kstart=min0(i+1,j)
4858 cgrad kend=max0(i-1,j-1)
4859 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4860 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4861 cgrad do k=kstart,kend
4863 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4867 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4868 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4879 C-----------------------------------------------------------------------------
4880 subroutine escp(evdw2,evdw2_14)
4882 C This subroutine calculates the excluded-volume interaction energy between
4883 C peptide-group centers and side chains and its gradient in virtual-bond and
4884 C side-chain vectors.
4886 implicit real*8 (a-h,o-z)
4887 include 'DIMENSIONS'
4888 include 'COMMON.GEO'
4889 include 'COMMON.VAR'
4890 include 'COMMON.LOCAL'
4891 include 'COMMON.CHAIN'
4892 include 'COMMON.DERIV'
4893 include 'COMMON.INTERACT'
4894 include 'COMMON.FFIELD'
4895 include 'COMMON.IOUNITS'
4896 include 'COMMON.CONTROL'
4897 include 'COMMON.SPLITELE'
4901 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
4902 cd print '(a)','Enter ESCP'
4903 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4907 do i=iatscp_s,iatscp_e
4908 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4910 xi=0.5D0*(c(1,i)+c(1,i+1))
4911 yi=0.5D0*(c(2,i)+c(2,i+1))
4912 zi=0.5D0*(c(3,i)+c(3,i+1))
4914 if (xi.lt.0) xi=xi+boxxsize
4916 if (yi.lt.0) yi=yi+boxysize
4918 if (zi.lt.0) zi=zi+boxzsize
4919 c xi=xi+xshift*boxxsize
4920 c yi=yi+yshift*boxysize
4921 c zi=zi+zshift*boxzsize
4922 c print *,xi,yi,zi,'polozenie i'
4923 C Return atom into box, boxxsize is size of box in x dimension
4925 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4926 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4927 C Condition for being inside the proper box
4928 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4929 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4933 c print *,xi,boxxsize,"pierwszy"
4935 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4936 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4937 C Condition for being inside the proper box
4938 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4939 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4943 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4944 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4945 C Condition for being inside the proper box
4946 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4947 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4950 do iint=1,nscp_gr(i)
4952 do j=iscpstart(i,iint),iscpend(i,iint)
4953 itypj=iabs(itype(j))
4954 if (itypj.eq.ntyp1) cycle
4955 C Uncomment following three lines for SC-p interactions
4959 C Uncomment following three lines for Ca-p interactions
4964 if (xj.lt.0) xj=xj+boxxsize
4966 if (yj.lt.0) yj=yj+boxysize
4968 if (zj.lt.0) zj=zj+boxzsize
4970 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4971 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4972 C Condition for being inside the proper box
4973 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4974 c & (xj.lt.((-0.5d0)*boxxsize))) then
4978 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4979 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4980 cC Condition for being inside the proper box
4981 c if ((yj.gt.((0.5d0)*boxysize)).or.
4982 c & (yj.lt.((-0.5d0)*boxysize))) then
4986 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4987 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4988 C Condition for being inside the proper box
4989 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4990 c & (zj.lt.((-0.5d0)*boxzsize))) then
4993 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
4994 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5002 xj=xj_safe+xshift*boxxsize
5003 yj=yj_safe+yshift*boxysize
5004 zj=zj_safe+zshift*boxzsize
5005 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5006 if(dist_temp.lt.dist_init) then
5016 if (subchap.eq.1) then
5025 c print *,xj,yj,zj,'polozenie j'
5026 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5028 sss=sscale(1.0d0/(dsqrt(rrij)))
5029 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
5030 c if (sss.eq.0) print *,'czasem jest OK'
5031 if (sss.le.0.0d0) cycle
5032 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5034 e1=fac*fac*aad(itypj,iteli)
5035 e2=fac*bad(itypj,iteli)
5036 if (iabs(j-i) .le. 2) then
5039 evdw2_14=evdw2_14+(e1+e2)*sss
5042 evdw2=evdw2+evdwij*sss
5043 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5044 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
5047 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5049 fac=-(evdwij+e1)*rrij*sss
5050 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5054 cgrad if (j.lt.i) then
5055 cd write (iout,*) 'j<i'
5056 C Uncomment following three lines for SC-p interactions
5058 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5061 cd write (iout,*) 'j>i'
5063 cgrad ggg(k)=-ggg(k)
5064 C Uncomment following line for SC-p interactions
5065 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5066 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5070 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5072 cgrad kstart=min0(i+1,j)
5073 cgrad kend=max0(i-1,j-1)
5074 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5075 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5076 cgrad do k=kstart,kend
5078 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5082 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5083 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5085 c endif !endif for sscale cutoff
5095 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5096 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5097 gradx_scp(j,i)=expon*gradx_scp(j,i)
5100 C******************************************************************************
5104 C To save time the factor EXPON has been extracted from ALL components
5105 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5108 C******************************************************************************
5111 C--------------------------------------------------------------------------
5112 subroutine edis(ehpb)
5114 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5116 implicit real*8 (a-h,o-z)
5117 include 'DIMENSIONS'
5118 include 'COMMON.SBRIDGE'
5119 include 'COMMON.CHAIN'
5120 include 'COMMON.DERIV'
5121 include 'COMMON.VAR'
5122 include 'COMMON.INTERACT'
5123 include 'COMMON.IOUNITS'
5126 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5127 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
5128 if (link_end.eq.0) return
5129 do i=link_start,link_end
5130 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5131 C CA-CA distance used in regularization of structure.
5134 C iii and jjj point to the residues for which the distance is assigned.
5135 if (ii.gt.nres) then
5142 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5143 c & dhpb(i),dhpb1(i),forcon(i)
5144 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5145 C distance and angle dependent SS bond potential.
5146 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5147 C & iabs(itype(jjj)).eq.1) then
5148 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5149 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5150 if (.not.dyn_ss .and. i.le.nss) then
5151 C 15/02/13 CC dynamic SSbond - additional check
5153 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5154 call ssbond_ene(iii,jjj,eij)
5157 cd write (iout,*) "eij",eij
5159 C Calculate the distance between the two points and its difference from the
5163 C Get the force constant corresponding to this distance.
5165 C Calculate the contribution to energy.
5166 ehpb=ehpb+waga*rdis*rdis
5168 C Evaluate gradient.
5171 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
5172 cd & ' waga=',waga,' fac=',fac
5174 ggg(j)=fac*(c(j,jj)-c(j,ii))
5176 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5177 C If this is a SC-SC distance, we need to calculate the contributions to the
5178 C Cartesian gradient in the SC vectors (ghpbx).
5181 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5182 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5185 cgrad do j=iii,jjj-1
5187 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5191 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5192 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5199 C--------------------------------------------------------------------------
5200 subroutine ssbond_ene(i,j,eij)
5202 C Calculate the distance and angle dependent SS-bond potential energy
5203 C using a free-energy function derived based on RHF/6-31G** ab initio
5204 C calculations of diethyl disulfide.
5206 C A. Liwo and U. Kozlowska, 11/24/03
5208 implicit real*8 (a-h,o-z)
5209 include 'DIMENSIONS'
5210 include 'COMMON.SBRIDGE'
5211 include 'COMMON.CHAIN'
5212 include 'COMMON.DERIV'
5213 include 'COMMON.LOCAL'
5214 include 'COMMON.INTERACT'
5215 include 'COMMON.VAR'
5216 include 'COMMON.IOUNITS'
5217 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5218 itypi=iabs(itype(i))
5222 dxi=dc_norm(1,nres+i)
5223 dyi=dc_norm(2,nres+i)
5224 dzi=dc_norm(3,nres+i)
5225 c dsci_inv=dsc_inv(itypi)
5226 dsci_inv=vbld_inv(nres+i)
5227 itypj=iabs(itype(j))
5228 c dscj_inv=dsc_inv(itypj)
5229 dscj_inv=vbld_inv(nres+j)
5233 dxj=dc_norm(1,nres+j)
5234 dyj=dc_norm(2,nres+j)
5235 dzj=dc_norm(3,nres+j)
5236 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5241 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5242 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5243 om12=dxi*dxj+dyi*dyj+dzi*dzj
5245 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5246 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5252 deltat12=om2-om1+2.0d0
5254 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5255 & +akct*deltad*deltat12
5256 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5257 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5258 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5259 c & " deltat12",deltat12," eij",eij
5260 ed=2*akcm*deltad+akct*deltat12
5262 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5263 eom1=-2*akth*deltat1-pom1-om2*pom2
5264 eom2= 2*akth*deltat2+pom1-om1*pom2
5267 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5268 ghpbx(k,i)=ghpbx(k,i)-ggk
5269 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5270 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5271 ghpbx(k,j)=ghpbx(k,j)+ggk
5272 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5273 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5274 ghpbc(k,i)=ghpbc(k,i)-ggk
5275 ghpbc(k,j)=ghpbc(k,j)+ggk
5278 C Calculate the components of the gradient in DC and X
5282 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5287 C--------------------------------------------------------------------------
5288 subroutine ebond(estr)
5290 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5292 implicit real*8 (a-h,o-z)
5293 include 'DIMENSIONS'
5294 include 'COMMON.LOCAL'
5295 include 'COMMON.GEO'
5296 include 'COMMON.INTERACT'
5297 include 'COMMON.DERIV'
5298 include 'COMMON.VAR'
5299 include 'COMMON.CHAIN'
5300 include 'COMMON.IOUNITS'
5301 include 'COMMON.NAMES'
5302 include 'COMMON.FFIELD'
5303 include 'COMMON.CONTROL'
5304 include 'COMMON.SETUP'
5305 double precision u(3),ud(3)
5308 do i=ibondp_start,ibondp_end
5309 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5310 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5312 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5313 c & *dc(j,i-1)/vbld(i)
5315 c if (energy_dec) write(iout,*)
5316 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5318 C Checking if it involves dummy (NH3+ or COO-) group
5319 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5320 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5321 diff = vbld(i)-vbldpDUM
5323 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5324 diff = vbld(i)-vbldp0
5326 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5327 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5330 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5332 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5335 estr=0.5d0*AKP*estr+estr1
5337 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5339 do i=ibond_start,ibond_end
5341 if (iti.ne.10 .and. iti.ne.ntyp1) then
5344 diff=vbld(i+nres)-vbldsc0(1,iti)
5345 if (energy_dec) write (iout,*)
5346 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5347 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5348 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5350 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5354 diff=vbld(i+nres)-vbldsc0(j,iti)
5355 ud(j)=aksc(j,iti)*diff
5356 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5370 uprod2=uprod2*u(k)*u(k)
5374 usumsqder=usumsqder+ud(j)*uprod2
5376 estr=estr+uprod/usum
5378 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5386 C--------------------------------------------------------------------------
5387 subroutine ebend(etheta)
5389 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5390 C angles gamma and its derivatives in consecutive thetas and gammas.
5392 implicit real*8 (a-h,o-z)
5393 include 'DIMENSIONS'
5394 include 'COMMON.LOCAL'
5395 include 'COMMON.GEO'
5396 include 'COMMON.INTERACT'
5397 include 'COMMON.DERIV'
5398 include 'COMMON.VAR'
5399 include 'COMMON.CHAIN'
5400 include 'COMMON.IOUNITS'
5401 include 'COMMON.NAMES'
5402 include 'COMMON.FFIELD'
5403 include 'COMMON.CONTROL'
5404 common /calcthet/ term1,term2,termm,diffak,ratak,
5405 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5406 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5407 double precision y(2),z(2)
5409 c time11=dexp(-2*time)
5412 c write (*,'(a,i2)') 'EBEND ICG=',icg
5413 do i=ithet_start,ithet_end
5414 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5415 & .or.itype(i).eq.ntyp1) cycle
5416 C Zero the energy function and its derivative at 0 or pi.
5417 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5419 ichir1=isign(1,itype(i-2))
5420 ichir2=isign(1,itype(i))
5421 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5422 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5423 if (itype(i-1).eq.10) then
5424 itype1=isign(10,itype(i-2))
5425 ichir11=isign(1,itype(i-2))
5426 ichir12=isign(1,itype(i-2))
5427 itype2=isign(10,itype(i))
5428 ichir21=isign(1,itype(i))
5429 ichir22=isign(1,itype(i))
5432 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5435 if (phii.ne.phii) phii=150.0
5445 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5448 if (phii1.ne.phii1) phii1=150.0
5460 C Calculate the "mean" value of theta from the part of the distribution
5461 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5462 C In following comments this theta will be referred to as t_c.
5463 thet_pred_mean=0.0d0
5465 athetk=athet(k,it,ichir1,ichir2)
5466 bthetk=bthet(k,it,ichir1,ichir2)
5468 athetk=athet(k,itype1,ichir11,ichir12)
5469 bthetk=bthet(k,itype2,ichir21,ichir22)
5471 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5472 c write(iout,*) 'chuj tu', y(k),z(k)
5474 dthett=thet_pred_mean*ssd
5475 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5476 C Derivatives of the "mean" values in gamma1 and gamma2.
5477 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5478 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5479 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5480 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5482 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5483 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5484 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5485 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5487 if (theta(i).gt.pi-delta) then
5488 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5490 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5491 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5492 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5494 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5496 else if (theta(i).lt.delta) then
5497 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5498 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5499 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5501 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5502 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5505 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5508 etheta=etheta+ethetai
5509 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5510 & 'ebend',i,ethetai,theta(i),itype(i)
5511 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5512 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5513 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5515 C Ufff.... We've done all this!!!
5518 C---------------------------------------------------------------------------
5519 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5521 implicit real*8 (a-h,o-z)
5522 include 'DIMENSIONS'
5523 include 'COMMON.LOCAL'
5524 include 'COMMON.IOUNITS'
5525 common /calcthet/ term1,term2,termm,diffak,ratak,
5526 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5527 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5528 C Calculate the contributions to both Gaussian lobes.
5529 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5530 C The "polynomial part" of the "standard deviation" of this part of
5531 C the distributioni.
5532 ccc write (iout,*) thetai,thet_pred_mean
5535 sig=sig*thet_pred_mean+polthet(j,it)
5537 C Derivative of the "interior part" of the "standard deviation of the"
5538 C gamma-dependent Gaussian lobe in t_c.
5539 sigtc=3*polthet(3,it)
5541 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5544 C Set the parameters of both Gaussian lobes of the distribution.
5545 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5546 fac=sig*sig+sigc0(it)
5549 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5550 sigsqtc=-4.0D0*sigcsq*sigtc
5551 c print *,i,sig,sigtc,sigsqtc
5552 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5553 sigtc=-sigtc/(fac*fac)
5554 C Following variable is sigma(t_c)**(-2)
5555 sigcsq=sigcsq*sigcsq
5557 sig0inv=1.0D0/sig0i**2
5558 delthec=thetai-thet_pred_mean
5559 delthe0=thetai-theta0i
5560 term1=-0.5D0*sigcsq*delthec*delthec
5561 term2=-0.5D0*sig0inv*delthe0*delthe0
5562 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5563 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5564 C NaNs in taking the logarithm. We extract the largest exponent which is added
5565 C to the energy (this being the log of the distribution) at the end of energy
5566 C term evaluation for this virtual-bond angle.
5567 if (term1.gt.term2) then
5569 term2=dexp(term2-termm)
5573 term1=dexp(term1-termm)
5576 C The ratio between the gamma-independent and gamma-dependent lobes of
5577 C the distribution is a Gaussian function of thet_pred_mean too.
5578 diffak=gthet(2,it)-thet_pred_mean
5579 ratak=diffak/gthet(3,it)**2
5580 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5581 C Let's differentiate it in thet_pred_mean NOW.
5583 C Now put together the distribution terms to make complete distribution.
5584 termexp=term1+ak*term2
5585 termpre=sigc+ak*sig0i
5586 C Contribution of the bending energy from this theta is just the -log of
5587 C the sum of the contributions from the two lobes and the pre-exponential
5588 C factor. Simple enough, isn't it?
5589 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5590 C write (iout,*) 'termexp',termexp,termm,termpre,i
5591 C NOW the derivatives!!!
5592 C 6/6/97 Take into account the deformation.
5593 E_theta=(delthec*sigcsq*term1
5594 & +ak*delthe0*sig0inv*term2)/termexp
5595 E_tc=((sigtc+aktc*sig0i)/termpre
5596 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5597 & aktc*term2)/termexp)
5600 c-----------------------------------------------------------------------------
5601 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5602 implicit real*8 (a-h,o-z)
5603 include 'DIMENSIONS'
5604 include 'COMMON.LOCAL'
5605 include 'COMMON.IOUNITS'
5606 common /calcthet/ term1,term2,termm,diffak,ratak,
5607 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5608 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5609 delthec=thetai-thet_pred_mean
5610 delthe0=thetai-theta0i
5611 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5612 t3 = thetai-thet_pred_mean
5616 t14 = t12+t6*sigsqtc
5618 t21 = thetai-theta0i
5624 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5625 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5626 & *(-t12*t9-ak*sig0inv*t27)
5630 C--------------------------------------------------------------------------
5631 subroutine ebend(etheta)
5633 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5634 C angles gamma and its derivatives in consecutive thetas and gammas.
5635 C ab initio-derived potentials from
5636 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5638 implicit real*8 (a-h,o-z)
5639 include 'DIMENSIONS'
5640 include 'COMMON.LOCAL'
5641 include 'COMMON.GEO'
5642 include 'COMMON.INTERACT'
5643 include 'COMMON.DERIV'
5644 include 'COMMON.VAR'
5645 include 'COMMON.CHAIN'
5646 include 'COMMON.IOUNITS'
5647 include 'COMMON.NAMES'
5648 include 'COMMON.FFIELD'
5649 include 'COMMON.CONTROL'
5650 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5651 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5652 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5653 & sinph1ph2(maxdouble,maxdouble)
5654 logical lprn /.false./, lprn1 /.false./
5656 do i=ithet_start,ithet_end
5658 c print *,i,itype(i-1),itype(i),itype(i-2)
5659 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1)
5660 & .or.(itype(i).eq.ntyp1)) cycle
5661 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
5663 if (iabs(itype(i+1)).eq.20) iblock=2
5664 if (iabs(itype(i+1)).ne.20) iblock=1
5668 theti2=0.5d0*theta(i)
5669 ityp2=ithetyp((itype(i-1)))
5671 coskt(k)=dcos(k*theti2)
5672 sinkt(k)=dsin(k*theti2)
5674 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5677 if (phii.ne.phii) phii=150.0
5681 ityp1=ithetyp((itype(i-2)))
5682 C propagation of chirality for glycine type
5684 cosph1(k)=dcos(k*phii)
5685 sinph1(k)=dsin(k*phii)
5695 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5698 if (phii1.ne.phii1) phii1=150.0
5703 ityp3=ithetyp((itype(i)))
5705 cosph2(k)=dcos(k*phii1)
5706 sinph2(k)=dsin(k*phii1)
5716 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5719 ccl=cosph1(l)*cosph2(k-l)
5720 ssl=sinph1(l)*sinph2(k-l)
5721 scl=sinph1(l)*cosph2(k-l)
5722 csl=cosph1(l)*sinph2(k-l)
5723 cosph1ph2(l,k)=ccl-ssl
5724 cosph1ph2(k,l)=ccl+ssl
5725 sinph1ph2(l,k)=scl+csl
5726 sinph1ph2(k,l)=scl-csl
5730 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5731 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5732 write (iout,*) "coskt and sinkt"
5734 write (iout,*) k,coskt(k),sinkt(k)
5738 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5739 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5742 & write (iout,*) "k",k,"
5743 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5744 & " ethetai",ethetai
5747 write (iout,*) "cosph and sinph"
5749 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5751 write (iout,*) "cosph1ph2 and sinph2ph2"
5754 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5755 & sinph1ph2(l,k),sinph1ph2(k,l)
5758 write(iout,*) "ethetai",ethetai
5762 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5763 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5764 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5765 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5766 ethetai=ethetai+sinkt(m)*aux
5767 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5768 dephii=dephii+k*sinkt(m)*(
5769 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5770 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5771 dephii1=dephii1+k*sinkt(m)*(
5772 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5773 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5775 & write (iout,*) "m",m," k",k," bbthet",
5776 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5777 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5778 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5779 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5783 & write(iout,*) "ethetai",ethetai
5787 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5788 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5789 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5790 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5791 ethetai=ethetai+sinkt(m)*aux
5792 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5793 dephii=dephii+l*sinkt(m)*(
5794 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5795 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5796 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5797 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5798 dephii1=dephii1+(k-l)*sinkt(m)*(
5799 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5800 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5801 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5802 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5804 write (iout,*) "m",m," k",k," l",l," ffthet",
5805 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5806 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5807 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5808 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5809 & " ethetai",ethetai
5810 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5811 & cosph1ph2(k,l)*sinkt(m),
5812 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5820 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5821 & i,theta(i)*rad2deg,phii*rad2deg,
5822 & phii1*rad2deg,ethetai
5824 etheta=etheta+ethetai
5825 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5827 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5828 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5829 gloc(nphi+i-2,icg)=wang*dethetai+gloc(nphi+i-2,icg)
5835 c-----------------------------------------------------------------------------
5836 subroutine esc(escloc)
5837 C Calculate the local energy of a side chain and its derivatives in the
5838 C corresponding virtual-bond valence angles THETA and the spherical angles
5840 implicit real*8 (a-h,o-z)
5841 include 'DIMENSIONS'
5842 include 'COMMON.GEO'
5843 include 'COMMON.LOCAL'
5844 include 'COMMON.VAR'
5845 include 'COMMON.INTERACT'
5846 include 'COMMON.DERIV'
5847 include 'COMMON.CHAIN'
5848 include 'COMMON.IOUNITS'
5849 include 'COMMON.NAMES'
5850 include 'COMMON.FFIELD'
5851 include 'COMMON.CONTROL'
5852 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5853 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5854 common /sccalc/ time11,time12,time112,theti,it,nlobit
5857 c write (iout,'(a)') 'ESC'
5858 do i=loc_start,loc_end
5860 if (it.eq.ntyp1) cycle
5861 if (it.eq.10) goto 1
5862 nlobit=nlob(iabs(it))
5863 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5864 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5865 theti=theta(i+1)-pipol
5870 if (x(2).gt.pi-delta) then
5874 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5876 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5877 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5879 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5880 & ddersc0(1),dersc(1))
5881 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5882 & ddersc0(3),dersc(3))
5884 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5886 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5887 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5888 & dersc0(2),esclocbi,dersc02)
5889 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5891 call splinthet(x(2),0.5d0*delta,ss,ssd)
5896 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5898 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5899 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5901 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5903 c write (iout,*) escloci
5904 else if (x(2).lt.delta) then
5908 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5910 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5911 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5913 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5914 & ddersc0(1),dersc(1))
5915 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5916 & ddersc0(3),dersc(3))
5918 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5920 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5921 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5922 & dersc0(2),esclocbi,dersc02)
5923 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5928 call splinthet(x(2),0.5d0*delta,ss,ssd)
5930 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5932 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5933 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5935 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5936 c write (iout,*) escloci
5938 call enesc(x,escloci,dersc,ddummy,.false.)
5941 escloc=escloc+escloci
5942 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5943 & 'escloc',i,escloci
5944 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5946 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5948 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5949 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5954 C---------------------------------------------------------------------------
5955 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5956 implicit real*8 (a-h,o-z)
5957 include 'DIMENSIONS'
5958 include 'COMMON.GEO'
5959 include 'COMMON.LOCAL'
5960 include 'COMMON.IOUNITS'
5961 common /sccalc/ time11,time12,time112,theti,it,nlobit
5962 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5963 double precision contr(maxlob,-1:1)
5965 c write (iout,*) 'it=',it,' nlobit=',nlobit
5969 if (mixed) ddersc(j)=0.0d0
5973 C Because of periodicity of the dependence of the SC energy in omega we have
5974 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5975 C To avoid underflows, first compute & store the exponents.
5983 z(k)=x(k)-censc(k,j,it)
5988 Axk=Axk+gaussc(l,k,j,it)*z(l)
5994 expfac=expfac+Ax(k,j,iii)*z(k)
6002 C As in the case of ebend, we want to avoid underflows in exponentiation and
6003 C subsequent NaNs and INFs in energy calculation.
6004 C Find the largest exponent
6008 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6012 cd print *,'it=',it,' emin=',emin
6014 C Compute the contribution to SC energy and derivatives
6019 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6020 if(adexp.ne.adexp) adexp=1.0
6023 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6025 cd print *,'j=',j,' expfac=',expfac
6026 escloc_i=escloc_i+expfac
6028 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6032 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6033 & +gaussc(k,2,j,it))*expfac
6040 dersc(1)=dersc(1)/cos(theti)**2
6041 ddersc(1)=ddersc(1)/cos(theti)**2
6044 escloci=-(dlog(escloc_i)-emin)
6046 dersc(j)=dersc(j)/escloc_i
6050 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6055 C------------------------------------------------------------------------------
6056 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6057 implicit real*8 (a-h,o-z)
6058 include 'DIMENSIONS'
6059 include 'COMMON.GEO'
6060 include 'COMMON.LOCAL'
6061 include 'COMMON.IOUNITS'
6062 common /sccalc/ time11,time12,time112,theti,it,nlobit
6063 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6064 double precision contr(maxlob)
6075 z(k)=x(k)-censc(k,j,it)
6081 Axk=Axk+gaussc(l,k,j,it)*z(l)
6087 expfac=expfac+Ax(k,j)*z(k)
6092 C As in the case of ebend, we want to avoid underflows in exponentiation and
6093 C subsequent NaNs and INFs in energy calculation.
6094 C Find the largest exponent
6097 if (emin.gt.contr(j)) emin=contr(j)
6101 C Compute the contribution to SC energy and derivatives
6105 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6106 escloc_i=escloc_i+expfac
6108 dersc(k)=dersc(k)+Ax(k,j)*expfac
6110 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6111 & +gaussc(1,2,j,it))*expfac
6115 dersc(1)=dersc(1)/cos(theti)**2
6116 dersc12=dersc12/cos(theti)**2
6117 escloci=-(dlog(escloc_i)-emin)
6119 dersc(j)=dersc(j)/escloc_i
6121 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6125 c----------------------------------------------------------------------------------
6126 subroutine esc(escloc)
6127 C Calculate the local energy of a side chain and its derivatives in the
6128 C corresponding virtual-bond valence angles THETA and the spherical angles
6129 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6130 C added by Urszula Kozlowska. 07/11/2007
6132 implicit real*8 (a-h,o-z)
6133 include 'DIMENSIONS'
6134 include 'COMMON.GEO'
6135 include 'COMMON.LOCAL'
6136 include 'COMMON.VAR'
6137 include 'COMMON.SCROT'
6138 include 'COMMON.INTERACT'
6139 include 'COMMON.DERIV'
6140 include 'COMMON.CHAIN'
6141 include 'COMMON.IOUNITS'
6142 include 'COMMON.NAMES'
6143 include 'COMMON.FFIELD'
6144 include 'COMMON.CONTROL'
6145 include 'COMMON.VECTORS'
6146 double precision x_prime(3),y_prime(3),z_prime(3)
6147 & , sumene,dsc_i,dp2_i,x(65),
6148 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6149 & de_dxx,de_dyy,de_dzz,de_dt
6150 double precision s1_t,s1_6_t,s2_t,s2_6_t
6152 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6153 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6154 & dt_dCi(3),dt_dCi1(3)
6155 common /sccalc/ time11,time12,time112,theti,it,nlobit
6158 do i=loc_start,loc_end
6159 if (itype(i).eq.ntyp1) cycle
6160 costtab(i+1) =dcos(theta(i+1))
6161 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6162 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6163 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6164 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6165 cosfac=dsqrt(cosfac2)
6166 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6167 sinfac=dsqrt(sinfac2)
6169 if (it.eq.10) goto 1
6171 C Compute the axes of tghe local cartesian coordinates system; store in
6172 c x_prime, y_prime and z_prime
6179 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6180 C & dc_norm(3,i+nres)
6182 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6183 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6186 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6189 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6190 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6191 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6192 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6193 c & " xy",scalar(x_prime(1),y_prime(1)),
6194 c & " xz",scalar(x_prime(1),z_prime(1)),
6195 c & " yy",scalar(y_prime(1),y_prime(1)),
6196 c & " yz",scalar(y_prime(1),z_prime(1)),
6197 c & " zz",scalar(z_prime(1),z_prime(1))
6199 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6200 C to local coordinate system. Store in xx, yy, zz.
6206 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6207 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6208 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6215 C Compute the energy of the ith side cbain
6217 c write (2,*) "xx",xx," yy",yy," zz",zz
6220 x(j) = sc_parmin(j,it)
6223 Cc diagnostics - remove later
6225 yy1 = dsin(alph(2))*dcos(omeg(2))
6226 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
6227 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6228 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6230 C," --- ", xx_w,yy_w,zz_w
6233 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6234 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6236 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6237 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6239 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6240 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6241 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6242 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6243 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6245 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6246 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6247 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6248 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6249 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6251 dsc_i = 0.743d0+x(61)
6253 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6254 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6255 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6256 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6257 s1=(1+x(63))/(0.1d0 + dscp1)
6258 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6259 s2=(1+x(65))/(0.1d0 + dscp2)
6260 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6261 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6262 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6263 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6265 c & dscp1,dscp2,sumene
6266 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6267 escloc = escloc + sumene
6268 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6273 C This section to check the numerical derivatives of the energy of ith side
6274 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6275 C #define DEBUG in the code to turn it on.
6277 write (2,*) "sumene =",sumene
6281 write (2,*) xx,yy,zz
6282 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6283 de_dxx_num=(sumenep-sumene)/aincr
6285 write (2,*) "xx+ sumene from enesc=",sumenep
6288 write (2,*) xx,yy,zz
6289 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6290 de_dyy_num=(sumenep-sumene)/aincr
6292 write (2,*) "yy+ sumene from enesc=",sumenep
6295 write (2,*) xx,yy,zz
6296 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6297 de_dzz_num=(sumenep-sumene)/aincr
6299 write (2,*) "zz+ sumene from enesc=",sumenep
6300 costsave=cost2tab(i+1)
6301 sintsave=sint2tab(i+1)
6302 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6303 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6304 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6305 de_dt_num=(sumenep-sumene)/aincr
6306 write (2,*) " t+ sumene from enesc=",sumenep
6307 cost2tab(i+1)=costsave
6308 sint2tab(i+1)=sintsave
6309 C End of diagnostics section.
6312 C Compute the gradient of esc
6314 c zz=zz*dsign(1.0,dfloat(itype(i)))
6315 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6316 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6317 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6318 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6319 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6320 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6321 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6322 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6323 pom1=(sumene3*sint2tab(i+1)+sumene1)
6324 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6325 pom2=(sumene4*cost2tab(i+1)+sumene2)
6326 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6327 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6328 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6329 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6331 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6332 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6333 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6335 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6336 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6337 & +(pom1+pom2)*pom_dx
6339 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6342 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6343 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6344 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6346 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6347 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6348 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6349 & +x(59)*zz**2 +x(60)*xx*zz
6350 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6351 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6352 & +(pom1-pom2)*pom_dy
6354 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6357 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6358 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6359 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6360 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6361 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6362 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6363 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6364 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6366 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6369 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6370 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6371 & +pom1*pom_dt1+pom2*pom_dt2
6373 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6378 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6379 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6380 cosfac2xx=cosfac2*xx
6381 sinfac2yy=sinfac2*yy
6383 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6385 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6387 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6388 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6389 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6390 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6391 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6392 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6393 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6394 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6395 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6396 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6400 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6401 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6402 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6403 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6406 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6407 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6408 dZZ_XYZ(k)=vbld_inv(i+nres)*
6409 & (z_prime(k)-zz*dC_norm(k,i+nres))
6411 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6412 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6416 dXX_Ctab(k,i)=dXX_Ci(k)
6417 dXX_C1tab(k,i)=dXX_Ci1(k)
6418 dYY_Ctab(k,i)=dYY_Ci(k)
6419 dYY_C1tab(k,i)=dYY_Ci1(k)
6420 dZZ_Ctab(k,i)=dZZ_Ci(k)
6421 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6422 dXX_XYZtab(k,i)=dXX_XYZ(k)
6423 dYY_XYZtab(k,i)=dYY_XYZ(k)
6424 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6428 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6429 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6430 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6431 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6432 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6434 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6435 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6436 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6437 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6438 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6439 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6440 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6441 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6443 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6444 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6446 C to check gradient call subroutine check_grad
6452 c------------------------------------------------------------------------------
6453 double precision function enesc(x,xx,yy,zz,cost2,sint2)
6455 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
6456 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6457 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6458 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6460 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6461 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6463 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6464 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6465 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6466 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6467 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6469 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6470 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6471 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6472 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6473 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6475 dsc_i = 0.743d0+x(61)
6477 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6478 & *(xx*cost2+yy*sint2))
6479 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6480 & *(xx*cost2-yy*sint2))
6481 s1=(1+x(63))/(0.1d0 + dscp1)
6482 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6483 s2=(1+x(65))/(0.1d0 + dscp2)
6484 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6485 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
6486 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
6491 c------------------------------------------------------------------------------
6492 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6494 C This procedure calculates two-body contact function g(rij) and its derivative:
6497 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6500 C where x=(rij-r0ij)/delta
6502 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6505 double precision rij,r0ij,eps0ij,fcont,fprimcont
6506 double precision x,x2,x4,delta
6510 if (x.lt.-1.0D0) then
6513 else if (x.le.1.0D0) then
6516 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6517 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6524 c------------------------------------------------------------------------------
6525 subroutine splinthet(theti,delta,ss,ssder)
6526 implicit real*8 (a-h,o-z)
6527 include 'DIMENSIONS'
6528 include 'COMMON.VAR'
6529 include 'COMMON.GEO'
6532 if (theti.gt.pipol) then
6533 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6535 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6540 c------------------------------------------------------------------------------
6541 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6543 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6544 double precision ksi,ksi2,ksi3,a1,a2,a3
6545 a1=fprim0*delta/(f1-f0)
6551 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6552 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6555 c------------------------------------------------------------------------------
6556 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6558 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6559 double precision ksi,ksi2,ksi3,a1,a2,a3
6564 a2=3*(f1x-f0x)-2*fprim0x*delta
6565 a3=fprim0x*delta-2*(f1x-f0x)
6566 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6569 C-----------------------------------------------------------------------------
6571 C-----------------------------------------------------------------------------
6572 subroutine etor(etors,edihcnstr)
6573 implicit real*8 (a-h,o-z)
6574 include 'DIMENSIONS'
6575 include 'COMMON.VAR'
6576 include 'COMMON.GEO'
6577 include 'COMMON.LOCAL'
6578 include 'COMMON.TORSION'
6579 include 'COMMON.INTERACT'
6580 include 'COMMON.DERIV'
6581 include 'COMMON.CHAIN'
6582 include 'COMMON.NAMES'
6583 include 'COMMON.IOUNITS'
6584 include 'COMMON.FFIELD'
6585 include 'COMMON.TORCNSTR'
6586 include 'COMMON.CONTROL'
6588 C Set lprn=.true. for debugging
6592 do i=iphi_start,iphi_end
6594 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6595 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6596 itori=itortyp(itype(i-2))
6597 itori1=itortyp(itype(i-1))
6600 C Proline-Proline pair is a special case...
6601 if (itori.eq.3 .and. itori1.eq.3) then
6602 if (phii.gt.-dwapi3) then
6604 fac=1.0D0/(1.0D0-cosphi)
6605 etorsi=v1(1,3,3)*fac
6606 etorsi=etorsi+etorsi
6607 etors=etors+etorsi-v1(1,3,3)
6608 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6609 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6612 v1ij=v1(j+1,itori,itori1)
6613 v2ij=v2(j+1,itori,itori1)
6616 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6617 if (energy_dec) etors_ii=etors_ii+
6618 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6619 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6623 v1ij=v1(j,itori,itori1)
6624 v2ij=v2(j,itori,itori1)
6627 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6628 if (energy_dec) etors_ii=etors_ii+
6629 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6630 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6633 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6636 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6637 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6638 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6639 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6640 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6642 ! 6/20/98 - dihedral angle constraints
6645 itori=idih_constr(i)
6648 if (difi.gt.drange(i)) then
6650 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6651 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6652 else if (difi.lt.-drange(i)) then
6654 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6655 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6657 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6658 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6660 ! write (iout,*) 'edihcnstr',edihcnstr
6663 c------------------------------------------------------------------------------
6664 subroutine etor_d(etors_d)
6668 c----------------------------------------------------------------------------
6670 subroutine etor(etors,edihcnstr)
6671 implicit real*8 (a-h,o-z)
6672 include 'DIMENSIONS'
6673 include 'COMMON.VAR'
6674 include 'COMMON.GEO'
6675 include 'COMMON.LOCAL'
6676 include 'COMMON.TORSION'
6677 include 'COMMON.INTERACT'
6678 include 'COMMON.DERIV'
6679 include 'COMMON.CHAIN'
6680 include 'COMMON.NAMES'
6681 include 'COMMON.IOUNITS'
6682 include 'COMMON.FFIELD'
6683 include 'COMMON.TORCNSTR'
6684 include 'COMMON.CONTROL'
6686 C Set lprn=.true. for debugging
6690 do i=iphi_start,iphi_end
6691 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6692 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6693 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6694 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6695 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6696 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6697 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6698 C For introducing the NH3+ and COO- group please check the etor_d for reference
6701 if (iabs(itype(i)).eq.20) then
6706 itori=itortyp(itype(i-2))
6707 itori1=itortyp(itype(i-1))
6710 C Regular cosine and sine terms
6711 do j=1,nterm(itori,itori1,iblock)
6712 v1ij=v1(j,itori,itori1,iblock)
6713 v2ij=v2(j,itori,itori1,iblock)
6716 etors=etors+v1ij*cosphi+v2ij*sinphi
6717 if (energy_dec) etors_ii=etors_ii+
6718 & v1ij*cosphi+v2ij*sinphi
6719 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6723 C E = SUM ----------------------------------- - v1
6724 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6726 cosphi=dcos(0.5d0*phii)
6727 sinphi=dsin(0.5d0*phii)
6728 do j=1,nlor(itori,itori1,iblock)
6729 vl1ij=vlor1(j,itori,itori1)
6730 vl2ij=vlor2(j,itori,itori1)
6731 vl3ij=vlor3(j,itori,itori1)
6732 pom=vl2ij*cosphi+vl3ij*sinphi
6733 pom1=1.0d0/(pom*pom+1.0d0)
6734 etors=etors+vl1ij*pom1
6735 if (energy_dec) etors_ii=etors_ii+
6738 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6740 C Subtract the constant term
6741 etors=etors-v0(itori,itori1,iblock)
6742 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6743 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6745 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6746 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6747 & (v1(j,itori,itori1,iblock),j=1,6),
6748 & (v2(j,itori,itori1,iblock),j=1,6)
6749 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6750 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6752 ! 6/20/98 - dihedral angle constraints
6754 c do i=1,ndih_constr
6755 do i=idihconstr_start,idihconstr_end
6756 itori=idih_constr(i)
6758 difi=pinorm(phii-phi0(i))
6759 if (difi.gt.drange(i)) then
6761 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6762 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6763 else if (difi.lt.-drange(i)) then
6765 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6766 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6770 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6771 cd & rad2deg*phi0(i), rad2deg*drange(i),
6772 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6774 cd write (iout,*) 'edihcnstr',edihcnstr
6777 c----------------------------------------------------------------------------
6778 subroutine etor_d(etors_d)
6779 C 6/23/01 Compute double torsional energy
6780 implicit real*8 (a-h,o-z)
6781 include 'DIMENSIONS'
6782 include 'COMMON.VAR'
6783 include 'COMMON.GEO'
6784 include 'COMMON.LOCAL'
6785 include 'COMMON.TORSION'
6786 include 'COMMON.INTERACT'
6787 include 'COMMON.DERIV'
6788 include 'COMMON.CHAIN'
6789 include 'COMMON.NAMES'
6790 include 'COMMON.IOUNITS'
6791 include 'COMMON.FFIELD'
6792 include 'COMMON.TORCNSTR'
6793 include 'COMMON.CONTROL'
6795 C Set lprn=.true. for debugging
6799 c write(iout,*) "a tu??"
6800 do i=iphid_start,iphid_end
6801 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6802 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6803 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6804 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6805 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6806 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6807 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6808 & (itype(i+1).eq.ntyp1)) cycle
6809 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6811 itori=itortyp(itype(i-2))
6812 itori1=itortyp(itype(i-1))
6813 itori2=itortyp(itype(i))
6819 if (iabs(itype(i+1)).eq.20) iblock=2
6820 C Iblock=2 Proline type
6821 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6822 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6823 C if (itype(i+1).eq.ntyp1) iblock=3
6824 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6825 C IS or IS NOT need for this
6826 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6827 C is (itype(i-3).eq.ntyp1) ntblock=2
6828 C ntblock is N-terminal blocking group
6830 C Regular cosine and sine terms
6831 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6832 C Example of changes for NH3+ blocking group
6833 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6834 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6835 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6836 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6837 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6838 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6839 cosphi1=dcos(j*phii)
6840 sinphi1=dsin(j*phii)
6841 cosphi2=dcos(j*phii1)
6842 sinphi2=dsin(j*phii1)
6843 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6844 & v2cij*cosphi2+v2sij*sinphi2
6845 if (energy_dec) etors_d_ii=etors_d_ii+
6846 & v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
6847 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6848 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6850 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6852 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6853 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6854 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6855 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6856 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6857 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6858 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6859 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6860 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6861 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6862 if (energy_dec) etors_d_ii=etors_d_ii+
6863 & v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6864 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6865 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6866 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6867 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6868 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6871 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6872 & 'etor_d',i,etors_d_ii
6873 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6874 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6879 c------------------------------------------------------------------------------
6880 subroutine eback_sc_corr(esccor)
6881 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6882 c conformational states; temporarily implemented as differences
6883 c between UNRES torsional potentials (dependent on three types of
6884 c residues) and the torsional potentials dependent on all 20 types
6885 c of residues computed from AM1 energy surfaces of terminally-blocked
6886 c amino-acid residues.
6887 implicit real*8 (a-h,o-z)
6888 include 'DIMENSIONS'
6889 include 'COMMON.VAR'
6890 include 'COMMON.GEO'
6891 include 'COMMON.LOCAL'
6892 include 'COMMON.TORSION'
6893 include 'COMMON.SCCOR'
6894 include 'COMMON.INTERACT'
6895 include 'COMMON.DERIV'
6896 include 'COMMON.CHAIN'
6897 include 'COMMON.NAMES'
6898 include 'COMMON.IOUNITS'
6899 include 'COMMON.FFIELD'
6900 include 'COMMON.CONTROL'
6902 C Set lprn=.true. for debugging
6905 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6907 do i=itau_start,itau_end
6908 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6910 isccori=isccortyp(itype(i-2))
6911 isccori1=isccortyp(itype(i-1))
6912 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6914 do intertyp=1,3 !intertyp
6915 cc Added 09 May 2012 (Adasko)
6916 cc Intertyp means interaction type of backbone mainchain correlation:
6917 c 1 = SC...Ca...Ca...Ca
6918 c 2 = Ca...Ca...Ca...SC
6919 c 3 = SC...Ca...Ca...SCi
6921 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6922 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6923 & (itype(i-1).eq.ntyp1)))
6924 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6925 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6926 & .or.(itype(i).eq.ntyp1)))
6927 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6928 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6929 & (itype(i-3).eq.ntyp1)))) cycle
6930 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6931 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6933 do j=1,nterm_sccor(isccori,isccori1)
6934 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6935 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6936 cosphi=dcos(j*tauangle(intertyp,i))
6937 sinphi=dsin(j*tauangle(intertyp,i))
6938 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6939 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6941 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6942 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6944 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6945 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6946 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6947 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6948 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6954 c----------------------------------------------------------------------------
6955 subroutine multibody(ecorr)
6956 C This subroutine calculates multi-body contributions to energy following
6957 C the idea of Skolnick et al. If side chains I and J make a contact and
6958 C at the same time side chains I+1 and J+1 make a contact, an extra
6959 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6960 implicit real*8 (a-h,o-z)
6961 include 'DIMENSIONS'
6962 include 'COMMON.IOUNITS'
6963 include 'COMMON.DERIV'
6964 include 'COMMON.INTERACT'
6965 include 'COMMON.CONTACTS'
6966 double precision gx(3),gx1(3)
6969 C Set lprn=.true. for debugging
6973 write (iout,'(a)') 'Contact function values:'
6975 write (iout,'(i2,20(1x,i2,f10.5))')
6976 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6991 num_conti=num_cont(i)
6992 num_conti1=num_cont(i1)
6997 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6998 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6999 cd & ' ishift=',ishift
7000 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7001 C The system gains extra energy.
7002 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7003 endif ! j1==j+-ishift
7012 c------------------------------------------------------------------------------
7013 double precision function esccorr(i,j,k,l,jj,kk)
7014 implicit real*8 (a-h,o-z)
7015 include 'DIMENSIONS'
7016 include 'COMMON.IOUNITS'
7017 include 'COMMON.DERIV'
7018 include 'COMMON.INTERACT'
7019 include 'COMMON.CONTACTS'
7020 double precision gx(3),gx1(3)
7025 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7026 C Calculate the multi-body contribution to energy.
7027 C Calculate multi-body contributions to the gradient.
7028 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7029 cd & k,l,(gacont(m,kk,k),m=1,3)
7031 gx(m) =ekl*gacont(m,jj,i)
7032 gx1(m)=eij*gacont(m,kk,k)
7033 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7034 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7035 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7036 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7040 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7045 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7051 c------------------------------------------------------------------------------
7052 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7053 C This subroutine calculates multi-body contributions to hydrogen-bonding
7054 implicit real*8 (a-h,o-z)
7055 include 'DIMENSIONS'
7056 include 'COMMON.IOUNITS'
7059 parameter (max_cont=maxconts)
7060 parameter (max_dim=26)
7061 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7062 double precision zapas(max_dim,maxconts,max_fg_procs),
7063 & zapas_recv(max_dim,maxconts,max_fg_procs)
7064 common /przechowalnia/ zapas
7065 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7066 & status_array(MPI_STATUS_SIZE,maxconts*2)
7068 include 'COMMON.SETUP'
7069 include 'COMMON.FFIELD'
7070 include 'COMMON.DERIV'
7071 include 'COMMON.INTERACT'
7072 include 'COMMON.CONTACTS'
7073 include 'COMMON.CONTROL'
7074 include 'COMMON.LOCAL'
7075 double precision gx(3),gx1(3),time00
7078 C Set lprn=.true. for debugging
7083 if (nfgtasks.le.1) goto 30
7085 write (iout,'(a)') 'Contact function values before RECEIVE:'
7087 write (iout,'(2i3,50(1x,i2,f5.2))')
7088 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7089 & j=1,num_cont_hb(i))
7093 do i=1,ntask_cont_from
7096 do i=1,ntask_cont_to
7099 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7101 C Make the list of contacts to send to send to other procesors
7102 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7104 do i=iturn3_start,iturn3_end
7105 c write (iout,*) "make contact list turn3",i," num_cont",
7107 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7109 do i=iturn4_start,iturn4_end
7110 c write (iout,*) "make contact list turn4",i," num_cont",
7112 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7116 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7118 do j=1,num_cont_hb(i)
7121 iproc=iint_sent_local(k,jjc,ii)
7122 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7123 if (iproc.gt.0) then
7124 ncont_sent(iproc)=ncont_sent(iproc)+1
7125 nn=ncont_sent(iproc)
7127 zapas(2,nn,iproc)=jjc
7128 zapas(3,nn,iproc)=facont_hb(j,i)
7129 zapas(4,nn,iproc)=ees0p(j,i)
7130 zapas(5,nn,iproc)=ees0m(j,i)
7131 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7132 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7133 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7134 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7135 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7136 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7137 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7138 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7139 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7140 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7141 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7142 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7143 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7144 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7145 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7146 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7147 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7148 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7149 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7150 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7151 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7158 & "Numbers of contacts to be sent to other processors",
7159 & (ncont_sent(i),i=1,ntask_cont_to)
7160 write (iout,*) "Contacts sent"
7161 do ii=1,ntask_cont_to
7163 iproc=itask_cont_to(ii)
7164 write (iout,*) nn," contacts to processor",iproc,
7165 & " of CONT_TO_COMM group"
7167 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7175 CorrelID1=nfgtasks+fg_rank+1
7177 C Receive the numbers of needed contacts from other processors
7178 do ii=1,ntask_cont_from
7179 iproc=itask_cont_from(ii)
7181 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7182 & FG_COMM,req(ireq),IERR)
7184 c write (iout,*) "IRECV ended"
7186 C Send the number of contacts needed by other processors
7187 do ii=1,ntask_cont_to
7188 iproc=itask_cont_to(ii)
7190 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7191 & FG_COMM,req(ireq),IERR)
7193 c write (iout,*) "ISEND ended"
7194 c write (iout,*) "number of requests (nn)",ireq
7197 & call MPI_Waitall(ireq,req,status_array,ierr)
7199 c & "Numbers of contacts to be received from other processors",
7200 c & (ncont_recv(i),i=1,ntask_cont_from)
7204 do ii=1,ntask_cont_from
7205 iproc=itask_cont_from(ii)
7207 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7208 c & " of CONT_TO_COMM group"
7212 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7213 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7214 c write (iout,*) "ireq,req",ireq,req(ireq)
7217 C Send the contacts to processors that need them
7218 do ii=1,ntask_cont_to
7219 iproc=itask_cont_to(ii)
7221 c write (iout,*) nn," contacts to processor",iproc,
7222 c & " of CONT_TO_COMM group"
7225 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7226 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7227 c write (iout,*) "ireq,req",ireq,req(ireq)
7229 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7233 c write (iout,*) "number of requests (contacts)",ireq
7234 c write (iout,*) "req",(req(i),i=1,4)
7237 & call MPI_Waitall(ireq,req,status_array,ierr)
7238 do iii=1,ntask_cont_from
7239 iproc=itask_cont_from(iii)
7242 write (iout,*) "Received",nn," contacts from processor",iproc,
7243 & " of CONT_FROM_COMM group"
7246 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7251 ii=zapas_recv(1,i,iii)
7252 c Flag the received contacts to prevent double-counting
7253 jj=-zapas_recv(2,i,iii)
7254 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7256 nnn=num_cont_hb(ii)+1
7259 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7260 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7261 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7262 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7263 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7264 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7265 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7266 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7267 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7268 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7269 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7270 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7271 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7272 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7273 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7274 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7275 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7276 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7277 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7278 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7279 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7280 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7281 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7282 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7287 write (iout,'(a)') 'Contact function values after receive:'
7289 write (iout,'(2i3,50(1x,i3,f5.2))')
7290 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7291 & j=1,num_cont_hb(i))
7298 write (iout,'(a)') 'Contact function values:'
7300 write (iout,'(2i3,50(1x,i3,f5.2))')
7301 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7302 & j=1,num_cont_hb(i))
7306 C Remove the loop below after debugging !!!
7313 C Calculate the local-electrostatic correlation terms
7314 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7316 num_conti=num_cont_hb(i)
7317 num_conti1=num_cont_hb(i+1)
7324 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7325 c & ' jj=',jj,' kk=',kk
7326 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7327 & .or. j.lt.0 .and. j1.gt.0) .and.
7328 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7329 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7330 C The system gains extra energy.
7331 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7332 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7333 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7335 else if (j1.eq.j) then
7336 C Contacts I-J and I-(J+1) occur simultaneously.
7337 C The system loses extra energy.
7338 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7343 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7344 c & ' jj=',jj,' kk=',kk
7346 C Contacts I-J and (I+1)-J occur simultaneously.
7347 C The system loses extra energy.
7348 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7355 c------------------------------------------------------------------------------
7356 subroutine add_hb_contact(ii,jj,itask)
7357 implicit real*8 (a-h,o-z)
7358 include "DIMENSIONS"
7359 include "COMMON.IOUNITS"
7362 parameter (max_cont=maxconts)
7363 parameter (max_dim=26)
7364 include "COMMON.CONTACTS"
7365 double precision zapas(max_dim,maxconts,max_fg_procs),
7366 & zapas_recv(max_dim,maxconts,max_fg_procs)
7367 common /przechowalnia/ zapas
7368 integer i,j,ii,jj,iproc,itask(4),nn
7369 c write (iout,*) "itask",itask
7372 if (iproc.gt.0) then
7373 do j=1,num_cont_hb(ii)
7375 c write (iout,*) "i",ii," j",jj," jjc",jjc
7377 ncont_sent(iproc)=ncont_sent(iproc)+1
7378 nn=ncont_sent(iproc)
7379 zapas(1,nn,iproc)=ii
7380 zapas(2,nn,iproc)=jjc
7381 zapas(3,nn,iproc)=facont_hb(j,ii)
7382 zapas(4,nn,iproc)=ees0p(j,ii)
7383 zapas(5,nn,iproc)=ees0m(j,ii)
7384 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7385 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7386 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7387 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7388 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7389 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7390 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7391 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7392 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7393 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7394 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7395 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7396 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7397 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7398 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7399 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7400 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7401 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7402 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7403 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7404 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7412 c------------------------------------------------------------------------------
7413 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7415 C This subroutine calculates multi-body contributions to hydrogen-bonding
7416 implicit real*8 (a-h,o-z)
7417 include 'DIMENSIONS'
7418 include 'COMMON.IOUNITS'
7421 parameter (max_cont=maxconts)
7422 parameter (max_dim=70)
7423 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7424 double precision zapas(max_dim,maxconts,max_fg_procs),
7425 & zapas_recv(max_dim,maxconts,max_fg_procs)
7426 common /przechowalnia/ zapas
7427 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7428 & status_array(MPI_STATUS_SIZE,maxconts*2)
7430 include 'COMMON.SETUP'
7431 include 'COMMON.FFIELD'
7432 include 'COMMON.DERIV'
7433 include 'COMMON.LOCAL'
7434 include 'COMMON.INTERACT'
7435 include 'COMMON.CONTACTS'
7436 include 'COMMON.CHAIN'
7437 include 'COMMON.CONTROL'
7438 double precision gx(3),gx1(3)
7439 integer num_cont_hb_old(maxres)
7441 double precision eello4,eello5,eelo6,eello_turn6
7442 external eello4,eello5,eello6,eello_turn6
7443 C Set lprn=.true. for debugging
7448 num_cont_hb_old(i)=num_cont_hb(i)
7452 if (nfgtasks.le.1) goto 30
7454 write (iout,'(a)') 'Contact function values before RECEIVE:'
7456 write (iout,'(2i3,50(1x,i2,f5.2))')
7457 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7458 & j=1,num_cont_hb(i))
7462 do i=1,ntask_cont_from
7465 do i=1,ntask_cont_to
7468 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7470 C Make the list of contacts to send to send to other procesors
7471 do i=iturn3_start,iturn3_end
7472 c write (iout,*) "make contact list turn3",i," num_cont",
7474 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7476 do i=iturn4_start,iturn4_end
7477 c write (iout,*) "make contact list turn4",i," num_cont",
7479 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7483 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7485 do j=1,num_cont_hb(i)
7488 iproc=iint_sent_local(k,jjc,ii)
7489 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7490 if (iproc.ne.0) then
7491 ncont_sent(iproc)=ncont_sent(iproc)+1
7492 nn=ncont_sent(iproc)
7494 zapas(2,nn,iproc)=jjc
7495 zapas(3,nn,iproc)=d_cont(j,i)
7499 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7504 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7512 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7523 & "Numbers of contacts to be sent to other processors",
7524 & (ncont_sent(i),i=1,ntask_cont_to)
7525 write (iout,*) "Contacts sent"
7526 do ii=1,ntask_cont_to
7528 iproc=itask_cont_to(ii)
7529 write (iout,*) nn," contacts to processor",iproc,
7530 & " of CONT_TO_COMM group"
7532 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7540 CorrelID1=nfgtasks+fg_rank+1
7542 C Receive the numbers of needed contacts from other processors
7543 do ii=1,ntask_cont_from
7544 iproc=itask_cont_from(ii)
7546 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7547 & FG_COMM,req(ireq),IERR)
7549 c write (iout,*) "IRECV ended"
7551 C Send the number of contacts needed by other processors
7552 do ii=1,ntask_cont_to
7553 iproc=itask_cont_to(ii)
7555 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7556 & FG_COMM,req(ireq),IERR)
7558 c write (iout,*) "ISEND ended"
7559 c write (iout,*) "number of requests (nn)",ireq
7562 & call MPI_Waitall(ireq,req,status_array,ierr)
7564 c & "Numbers of contacts to be received from other processors",
7565 c & (ncont_recv(i),i=1,ntask_cont_from)
7569 do ii=1,ntask_cont_from
7570 iproc=itask_cont_from(ii)
7572 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7573 c & " of CONT_TO_COMM group"
7577 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7578 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7579 c write (iout,*) "ireq,req",ireq,req(ireq)
7582 C Send the contacts to processors that need them
7583 do ii=1,ntask_cont_to
7584 iproc=itask_cont_to(ii)
7586 c write (iout,*) nn," contacts to processor",iproc,
7587 c & " of CONT_TO_COMM group"
7590 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7591 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7592 c write (iout,*) "ireq,req",ireq,req(ireq)
7594 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7598 c write (iout,*) "number of requests (contacts)",ireq
7599 c write (iout,*) "req",(req(i),i=1,4)
7602 & call MPI_Waitall(ireq,req,status_array,ierr)
7603 do iii=1,ntask_cont_from
7604 iproc=itask_cont_from(iii)
7607 write (iout,*) "Received",nn," contacts from processor",iproc,
7608 & " of CONT_FROM_COMM group"
7611 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7616 ii=zapas_recv(1,i,iii)
7617 c Flag the received contacts to prevent double-counting
7618 jj=-zapas_recv(2,i,iii)
7619 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7621 nnn=num_cont_hb(ii)+1
7624 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7628 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7633 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7641 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7650 write (iout,'(a)') 'Contact function values after receive:'
7652 write (iout,'(2i3,50(1x,i3,5f6.3))')
7653 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7654 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7661 write (iout,'(a)') 'Contact function values:'
7663 write (iout,'(2i3,50(1x,i2,5f6.3))')
7664 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7665 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7671 C Remove the loop below after debugging !!!
7678 C Calculate the dipole-dipole interaction energies
7679 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7680 do i=iatel_s,iatel_e+1
7681 num_conti=num_cont_hb(i)
7690 C Calculate the local-electrostatic correlation terms
7691 c write (iout,*) "gradcorr5 in eello5 before loop"
7693 c write (iout,'(i5,3f10.5)')
7694 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7696 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7697 c write (iout,*) "corr loop i",i
7699 num_conti=num_cont_hb(i)
7700 num_conti1=num_cont_hb(i+1)
7707 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7708 c & ' jj=',jj,' kk=',kk
7709 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7710 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7711 & .or. j.lt.0 .and. j1.gt.0) .and.
7712 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7713 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7714 C The system gains extra energy.
7716 sqd1=dsqrt(d_cont(jj,i))
7717 sqd2=dsqrt(d_cont(kk,i1))
7718 sred_geom = sqd1*sqd2
7719 IF (sred_geom.lt.cutoff_corr) THEN
7720 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7722 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7723 cd & ' jj=',jj,' kk=',kk
7724 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7725 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7727 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7728 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7731 cd write (iout,*) 'sred_geom=',sred_geom,
7732 cd & ' ekont=',ekont,' fprim=',fprimcont,
7733 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7734 cd write (iout,*) "g_contij",g_contij
7735 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7736 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7737 call calc_eello(i,jp,i+1,jp1,jj,kk)
7738 if (wcorr4.gt.0.0d0)
7739 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7740 if (energy_dec.and.wcorr4.gt.0.0d0)
7741 1 write (iout,'(a6,4i5,0pf7.3)')
7742 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7743 c write (iout,*) "gradcorr5 before eello5"
7745 c write (iout,'(i5,3f10.5)')
7746 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7748 if (wcorr5.gt.0.0d0)
7749 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7750 c write (iout,*) "gradcorr5 after eello5"
7752 c write (iout,'(i5,3f10.5)')
7753 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7755 if (energy_dec.and.wcorr5.gt.0.0d0)
7756 1 write (iout,'(a6,4i5,0pf7.3)')
7757 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7758 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7759 cd write(2,*)'ijkl',i,jp,i+1,jp1
7760 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7761 & .or. wturn6.eq.0.0d0))then
7762 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7763 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7764 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7765 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7766 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7767 cd & 'ecorr6=',ecorr6
7768 cd write (iout,'(4e15.5)') sred_geom,
7769 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7770 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7771 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7772 else if (wturn6.gt.0.0d0
7773 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7774 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7775 eturn6=eturn6+eello_turn6(i,jj,kk)
7776 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7777 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7778 cd write (2,*) 'multibody_eello:eturn6',eturn6
7787 num_cont_hb(i)=num_cont_hb_old(i)
7789 c write (iout,*) "gradcorr5 in eello5"
7791 c write (iout,'(i5,3f10.5)')
7792 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7796 c------------------------------------------------------------------------------
7797 subroutine add_hb_contact_eello(ii,jj,itask)
7798 implicit real*8 (a-h,o-z)
7799 include "DIMENSIONS"
7800 include "COMMON.IOUNITS"
7803 parameter (max_cont=maxconts)
7804 parameter (max_dim=70)
7805 include "COMMON.CONTACTS"
7806 double precision zapas(max_dim,maxconts,max_fg_procs),
7807 & zapas_recv(max_dim,maxconts,max_fg_procs)
7808 common /przechowalnia/ zapas
7809 integer i,j,ii,jj,iproc,itask(4),nn
7810 c write (iout,*) "itask",itask
7813 if (iproc.gt.0) then
7814 do j=1,num_cont_hb(ii)
7816 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7818 ncont_sent(iproc)=ncont_sent(iproc)+1
7819 nn=ncont_sent(iproc)
7820 zapas(1,nn,iproc)=ii
7821 zapas(2,nn,iproc)=jjc
7822 zapas(3,nn,iproc)=d_cont(j,ii)
7826 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7831 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7839 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7851 c------------------------------------------------------------------------------
7852 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7853 implicit real*8 (a-h,o-z)
7854 include 'DIMENSIONS'
7855 include 'COMMON.IOUNITS'
7856 include 'COMMON.DERIV'
7857 include 'COMMON.INTERACT'
7858 include 'COMMON.CONTACTS'
7859 double precision gx(3),gx1(3)
7869 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7870 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7871 C Following 4 lines for diagnostics.
7876 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7877 c & 'Contacts ',i,j,
7878 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7879 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7881 C Calculate the multi-body contribution to energy.
7882 c ecorr=ecorr+ekont*ees
7883 C Calculate multi-body contributions to the gradient.
7884 coeffpees0pij=coeffp*ees0pij
7885 coeffmees0mij=coeffm*ees0mij
7886 coeffpees0pkl=coeffp*ees0pkl
7887 coeffmees0mkl=coeffm*ees0mkl
7889 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7890 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7891 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7892 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7893 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7894 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7895 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7896 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7897 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7898 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7899 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7900 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7901 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7902 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7903 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7904 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7905 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7906 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7907 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7908 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7909 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7910 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7911 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7912 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7913 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7918 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7919 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7920 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7921 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7926 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7927 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7928 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7929 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7932 c write (iout,*) "ehbcorr",ekont*ees
7937 C---------------------------------------------------------------------------
7938 subroutine dipole(i,j,jj)
7939 implicit real*8 (a-h,o-z)
7940 include 'DIMENSIONS'
7941 include 'COMMON.IOUNITS'
7942 include 'COMMON.CHAIN'
7943 include 'COMMON.FFIELD'
7944 include 'COMMON.DERIV'
7945 include 'COMMON.INTERACT'
7946 include 'COMMON.CONTACTS'
7947 include 'COMMON.TORSION'
7948 include 'COMMON.VAR'
7949 include 'COMMON.GEO'
7950 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7952 iti1 = itortyp(itype(i+1))
7953 if (j.lt.nres-1) then
7954 itj1 = itortyp(itype(j+1))
7959 dipi(iii,1)=Ub2(iii,i)
7960 dipderi(iii)=Ub2der(iii,i)
7961 dipi(iii,2)=b1(iii,i+1)
7962 dipj(iii,1)=Ub2(iii,j)
7963 dipderj(iii)=Ub2der(iii,j)
7964 dipj(iii,2)=b1(iii,j+1)
7968 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7971 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7978 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7982 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7987 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7988 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7990 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7992 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7994 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7999 C---------------------------------------------------------------------------
8000 subroutine calc_eello(i,j,k,l,jj,kk)
8002 C This subroutine computes matrices and vectors needed to calculate
8003 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
8005 implicit real*8 (a-h,o-z)
8006 include 'DIMENSIONS'
8007 include 'COMMON.IOUNITS'
8008 include 'COMMON.CHAIN'
8009 include 'COMMON.DERIV'
8010 include 'COMMON.INTERACT'
8011 include 'COMMON.CONTACTS'
8012 include 'COMMON.TORSION'
8013 include 'COMMON.VAR'
8014 include 'COMMON.GEO'
8015 include 'COMMON.FFIELD'
8016 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8017 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8020 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8021 cd & ' jj=',jj,' kk=',kk
8022 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8023 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8024 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8027 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8028 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8031 call transpose2(aa1(1,1),aa1t(1,1))
8032 call transpose2(aa2(1,1),aa2t(1,1))
8035 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8036 & aa1tder(1,1,lll,kkk))
8037 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8038 & aa2tder(1,1,lll,kkk))
8042 C parallel orientation of the two CA-CA-CA frames.
8044 iti=itortyp(itype(i))
8048 itk1=itortyp(itype(k+1))
8049 itj=itortyp(itype(j))
8050 if (l.lt.nres-1) then
8051 itl1=itortyp(itype(l+1))
8055 C A1 kernel(j+1) A2T
8057 cd write (iout,'(3f10.5,5x,3f10.5)')
8058 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8060 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8061 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8062 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8063 C Following matrices are needed only for 6-th order cumulants
8064 IF (wcorr6.gt.0.0d0) THEN
8065 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8066 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8067 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8068 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8069 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8070 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8071 & ADtEAderx(1,1,1,1,1,1))
8073 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8074 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8075 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8076 & ADtEA1derx(1,1,1,1,1,1))
8078 C End 6-th order cumulants
8081 cd write (2,*) 'In calc_eello6'
8083 cd write (2,*) 'iii=',iii
8085 cd write (2,*) 'kkk=',kkk
8087 cd write (2,'(3(2f10.5),5x)')
8088 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8093 call transpose2(EUgder(1,1,k),auxmat(1,1))
8094 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8095 call transpose2(EUg(1,1,k),auxmat(1,1))
8096 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8097 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8101 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8102 & EAEAderx(1,1,lll,kkk,iii,1))
8106 C A1T kernel(i+1) A2
8107 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8108 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8109 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8110 C Following matrices are needed only for 6-th order cumulants
8111 IF (wcorr6.gt.0.0d0) THEN
8112 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8113 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
8114 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8115 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8116 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
8117 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8118 & ADtEAderx(1,1,1,1,1,2))
8119 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8120 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
8121 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8122 & ADtEA1derx(1,1,1,1,1,2))
8124 C End 6-th order cumulants
8125 call transpose2(EUgder(1,1,l),auxmat(1,1))
8126 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8127 call transpose2(EUg(1,1,l),auxmat(1,1))
8128 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8129 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8133 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8134 & EAEAderx(1,1,lll,kkk,iii,2))
8139 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8140 C They are needed only when the fifth- or the sixth-order cumulants are
8142 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8143 call transpose2(AEA(1,1,1),auxmat(1,1))
8144 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8145 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8146 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8147 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8148 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8149 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8150 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8151 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8152 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8153 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8154 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8155 call transpose2(AEA(1,1,2),auxmat(1,1))
8156 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
8157 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8158 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8159 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8160 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
8161 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8162 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
8163 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
8164 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8165 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8166 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8167 C Calculate the Cartesian derivatives of the vectors.
8171 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8172 call matvec2(auxmat(1,1),b1(1,i),
8173 & AEAb1derx(1,lll,kkk,iii,1,1))
8174 call matvec2(auxmat(1,1),Ub2(1,i),
8175 & AEAb2derx(1,lll,kkk,iii,1,1))
8176 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8177 & AEAb1derx(1,lll,kkk,iii,2,1))
8178 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8179 & AEAb2derx(1,lll,kkk,iii,2,1))
8180 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8181 call matvec2(auxmat(1,1),b1(1,j),
8182 & AEAb1derx(1,lll,kkk,iii,1,2))
8183 call matvec2(auxmat(1,1),Ub2(1,j),
8184 & AEAb2derx(1,lll,kkk,iii,1,2))
8185 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8186 & AEAb1derx(1,lll,kkk,iii,2,2))
8187 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
8188 & AEAb2derx(1,lll,kkk,iii,2,2))
8195 C Antiparallel orientation of the two CA-CA-CA frames.
8197 iti=itortyp(itype(i))
8201 itk1=itortyp(itype(k+1))
8202 itl=itortyp(itype(l))
8203 itj=itortyp(itype(j))
8204 if (j.lt.nres-1) then
8205 itj1=itortyp(itype(j+1))
8209 C A2 kernel(j-1)T A1T
8210 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8211 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
8212 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8213 C Following matrices are needed only for 6-th order cumulants
8214 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8215 & j.eq.i+4 .and. l.eq.i+3)) THEN
8216 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8217 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
8218 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8219 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8220 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8221 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8222 & ADtEAderx(1,1,1,1,1,1))
8223 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8224 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8225 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8226 & ADtEA1derx(1,1,1,1,1,1))
8228 C End 6-th order cumulants
8229 call transpose2(EUgder(1,1,k),auxmat(1,1))
8230 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8231 call transpose2(EUg(1,1,k),auxmat(1,1))
8232 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8233 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8237 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8238 & EAEAderx(1,1,lll,kkk,iii,1))
8242 C A2T kernel(i+1)T A1
8243 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8244 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
8245 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8246 C Following matrices are needed only for 6-th order cumulants
8247 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8248 & j.eq.i+4 .and. l.eq.i+3)) THEN
8249 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8250 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8251 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8252 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8253 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8254 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8255 & ADtEAderx(1,1,1,1,1,2))
8256 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8257 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8258 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8259 & ADtEA1derx(1,1,1,1,1,2))
8261 C End 6-th order cumulants
8262 call transpose2(EUgder(1,1,j),auxmat(1,1))
8263 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8264 call transpose2(EUg(1,1,j),auxmat(1,1))
8265 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8266 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8270 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8271 & EAEAderx(1,1,lll,kkk,iii,2))
8276 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8277 C They are needed only when the fifth- or the sixth-order cumulants are
8279 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8280 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8281 call transpose2(AEA(1,1,1),auxmat(1,1))
8282 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8283 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8284 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8285 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8286 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8287 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8288 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8289 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8290 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8291 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8292 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8293 call transpose2(AEA(1,1,2),auxmat(1,1))
8294 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
8295 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8296 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8297 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8298 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
8299 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8300 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
8301 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
8302 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8303 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8304 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8305 C Calculate the Cartesian derivatives of the vectors.
8309 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8310 call matvec2(auxmat(1,1),b1(1,i),
8311 & AEAb1derx(1,lll,kkk,iii,1,1))
8312 call matvec2(auxmat(1,1),Ub2(1,i),
8313 & AEAb2derx(1,lll,kkk,iii,1,1))
8314 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8315 & AEAb1derx(1,lll,kkk,iii,2,1))
8316 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8317 & AEAb2derx(1,lll,kkk,iii,2,1))
8318 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8319 call matvec2(auxmat(1,1),b1(1,l),
8320 & AEAb1derx(1,lll,kkk,iii,1,2))
8321 call matvec2(auxmat(1,1),Ub2(1,l),
8322 & AEAb2derx(1,lll,kkk,iii,1,2))
8323 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
8324 & AEAb1derx(1,lll,kkk,iii,2,2))
8325 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8326 & AEAb2derx(1,lll,kkk,iii,2,2))
8335 C---------------------------------------------------------------------------
8336 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8337 & KK,KKderg,AKA,AKAderg,AKAderx)
8341 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8342 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8343 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8348 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8350 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8353 cd if (lprn) write (2,*) 'In kernel'
8355 cd if (lprn) write (2,*) 'kkk=',kkk
8357 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8358 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8360 cd write (2,*) 'lll=',lll
8361 cd write (2,*) 'iii=1'
8363 cd write (2,'(3(2f10.5),5x)')
8364 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8367 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8368 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8370 cd write (2,*) 'lll=',lll
8371 cd write (2,*) 'iii=2'
8373 cd write (2,'(3(2f10.5),5x)')
8374 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8381 C---------------------------------------------------------------------------
8382 double precision function eello4(i,j,k,l,jj,kk)
8383 implicit real*8 (a-h,o-z)
8384 include 'DIMENSIONS'
8385 include 'COMMON.IOUNITS'
8386 include 'COMMON.CHAIN'
8387 include 'COMMON.DERIV'
8388 include 'COMMON.INTERACT'
8389 include 'COMMON.CONTACTS'
8390 include 'COMMON.TORSION'
8391 include 'COMMON.VAR'
8392 include 'COMMON.GEO'
8393 double precision pizda(2,2),ggg1(3),ggg2(3)
8394 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8398 cd print *,'eello4:',i,j,k,l,jj,kk
8399 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8400 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8401 cold eij=facont_hb(jj,i)
8402 cold ekl=facont_hb(kk,k)
8404 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8405 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8406 gcorr_loc(k-1)=gcorr_loc(k-1)
8407 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8409 gcorr_loc(l-1)=gcorr_loc(l-1)
8410 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8412 gcorr_loc(j-1)=gcorr_loc(j-1)
8413 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8418 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8419 & -EAEAderx(2,2,lll,kkk,iii,1)
8420 cd derx(lll,kkk,iii)=0.0d0
8424 cd gcorr_loc(l-1)=0.0d0
8425 cd gcorr_loc(j-1)=0.0d0
8426 cd gcorr_loc(k-1)=0.0d0
8428 cd write (iout,*)'Contacts have occurred for peptide groups',
8429 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8430 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8431 if (j.lt.nres-1) then
8438 if (l.lt.nres-1) then
8446 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8447 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8448 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8449 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8450 cgrad ghalf=0.5d0*ggg1(ll)
8451 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8452 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8453 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8454 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8455 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8456 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8457 cgrad ghalf=0.5d0*ggg2(ll)
8458 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8459 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8460 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8461 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8462 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8463 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8467 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8472 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8477 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8482 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8486 cd write (2,*) iii,gcorr_loc(iii)
8489 cd write (2,*) 'ekont',ekont
8490 cd write (iout,*) 'eello4',ekont*eel4
8493 C---------------------------------------------------------------------------
8494 double precision function eello5(i,j,k,l,jj,kk)
8495 implicit real*8 (a-h,o-z)
8496 include 'DIMENSIONS'
8497 include 'COMMON.IOUNITS'
8498 include 'COMMON.CHAIN'
8499 include 'COMMON.DERIV'
8500 include 'COMMON.INTERACT'
8501 include 'COMMON.CONTACTS'
8502 include 'COMMON.TORSION'
8503 include 'COMMON.VAR'
8504 include 'COMMON.GEO'
8505 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8506 double precision ggg1(3),ggg2(3)
8507 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8512 C /l\ / \ \ / \ / \ / C
8513 C / \ / \ \ / \ / \ / C
8514 C j| o |l1 | o | o| o | | o |o C
8515 C \ |/k\| |/ \| / |/ \| |/ \| C
8516 C \i/ \ / \ / / \ / \ C
8518 C (I) (II) (III) (IV) C
8520 C eello5_1 eello5_2 eello5_3 eello5_4 C
8522 C Antiparallel chains C
8525 C /j\ / \ \ / \ / \ / C
8526 C / \ / \ \ / \ / \ / C
8527 C j1| o |l | o | o| o | | o |o C
8528 C \ |/k\| |/ \| / |/ \| |/ \| C
8529 C \i/ \ / \ / / \ / \ C
8531 C (I) (II) (III) (IV) C
8533 C eello5_1 eello5_2 eello5_3 eello5_4 C
8535 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8537 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8538 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8543 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8545 itk=itortyp(itype(k))
8546 itl=itortyp(itype(l))
8547 itj=itortyp(itype(j))
8552 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8553 cd & eel5_3_num,eel5_4_num)
8557 derx(lll,kkk,iii)=0.0d0
8561 cd eij=facont_hb(jj,i)
8562 cd ekl=facont_hb(kk,k)
8564 cd write (iout,*)'Contacts have occurred for peptide groups',
8565 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8567 C Contribution from the graph I.
8568 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8569 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8570 call transpose2(EUg(1,1,k),auxmat(1,1))
8571 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8572 vv(1)=pizda(1,1)-pizda(2,2)
8573 vv(2)=pizda(1,2)+pizda(2,1)
8574 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8575 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8576 C Explicit gradient in virtual-dihedral angles.
8577 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8578 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8579 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8580 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8581 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8582 vv(1)=pizda(1,1)-pizda(2,2)
8583 vv(2)=pizda(1,2)+pizda(2,1)
8584 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8585 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8586 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8587 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8588 vv(1)=pizda(1,1)-pizda(2,2)
8589 vv(2)=pizda(1,2)+pizda(2,1)
8591 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8592 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8593 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8595 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8596 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8597 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8599 C Cartesian gradient
8603 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8605 vv(1)=pizda(1,1)-pizda(2,2)
8606 vv(2)=pizda(1,2)+pizda(2,1)
8607 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8608 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8609 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8615 C Contribution from graph II
8616 call transpose2(EE(1,1,itk),auxmat(1,1))
8617 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8618 vv(1)=pizda(1,1)+pizda(2,2)
8619 vv(2)=pizda(2,1)-pizda(1,2)
8620 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8621 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8622 C Explicit gradient in virtual-dihedral angles.
8623 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8624 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8625 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8626 vv(1)=pizda(1,1)+pizda(2,2)
8627 vv(2)=pizda(2,1)-pizda(1,2)
8629 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8630 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8631 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8633 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8634 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8635 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8637 C Cartesian gradient
8641 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8643 vv(1)=pizda(1,1)+pizda(2,2)
8644 vv(2)=pizda(2,1)-pizda(1,2)
8645 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8646 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8647 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8655 C Parallel orientation
8656 C Contribution from graph III
8657 call transpose2(EUg(1,1,l),auxmat(1,1))
8658 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8659 vv(1)=pizda(1,1)-pizda(2,2)
8660 vv(2)=pizda(1,2)+pizda(2,1)
8661 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8662 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8663 C Explicit gradient in virtual-dihedral angles.
8664 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8665 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8666 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8667 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8668 vv(1)=pizda(1,1)-pizda(2,2)
8669 vv(2)=pizda(1,2)+pizda(2,1)
8670 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8671 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8672 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8673 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8674 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8675 vv(1)=pizda(1,1)-pizda(2,2)
8676 vv(2)=pizda(1,2)+pizda(2,1)
8677 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8678 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8679 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8680 C Cartesian gradient
8684 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8686 vv(1)=pizda(1,1)-pizda(2,2)
8687 vv(2)=pizda(1,2)+pizda(2,1)
8688 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8689 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8690 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8695 C Contribution from graph IV
8697 call transpose2(EE(1,1,itl),auxmat(1,1))
8698 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8699 vv(1)=pizda(1,1)+pizda(2,2)
8700 vv(2)=pizda(2,1)-pizda(1,2)
8701 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8702 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8703 C Explicit gradient in virtual-dihedral angles.
8704 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8705 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8706 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8707 vv(1)=pizda(1,1)+pizda(2,2)
8708 vv(2)=pizda(2,1)-pizda(1,2)
8709 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8710 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8711 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8712 C Cartesian gradient
8716 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8718 vv(1)=pizda(1,1)+pizda(2,2)
8719 vv(2)=pizda(2,1)-pizda(1,2)
8720 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8721 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
8722 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8727 C Antiparallel orientation
8728 C Contribution from graph III
8730 call transpose2(EUg(1,1,j),auxmat(1,1))
8731 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8732 vv(1)=pizda(1,1)-pizda(2,2)
8733 vv(2)=pizda(1,2)+pizda(2,1)
8734 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8735 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8736 C Explicit gradient in virtual-dihedral angles.
8737 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8738 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8739 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8740 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8741 vv(1)=pizda(1,1)-pizda(2,2)
8742 vv(2)=pizda(1,2)+pizda(2,1)
8743 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8744 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8745 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8746 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8747 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8748 vv(1)=pizda(1,1)-pizda(2,2)
8749 vv(2)=pizda(1,2)+pizda(2,1)
8750 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8751 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8752 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8753 C Cartesian gradient
8757 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8759 vv(1)=pizda(1,1)-pizda(2,2)
8760 vv(2)=pizda(1,2)+pizda(2,1)
8761 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8762 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8763 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8768 C Contribution from graph IV
8770 call transpose2(EE(1,1,itj),auxmat(1,1))
8771 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8772 vv(1)=pizda(1,1)+pizda(2,2)
8773 vv(2)=pizda(2,1)-pizda(1,2)
8774 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
8775 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8776 C Explicit gradient in virtual-dihedral angles.
8777 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8778 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8779 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8780 vv(1)=pizda(1,1)+pizda(2,2)
8781 vv(2)=pizda(2,1)-pizda(1,2)
8782 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8783 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
8784 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8785 C Cartesian gradient
8789 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8791 vv(1)=pizda(1,1)+pizda(2,2)
8792 vv(2)=pizda(2,1)-pizda(1,2)
8793 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8794 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
8795 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8801 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8802 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8803 cd write (2,*) 'ijkl',i,j,k,l
8804 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8805 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8807 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8808 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8809 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8810 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8811 if (j.lt.nres-1) then
8818 if (l.lt.nres-1) then
8828 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8829 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8830 C summed up outside the subrouine as for the other subroutines
8831 C handling long-range interactions. The old code is commented out
8832 C with "cgrad" to keep track of changes.
8834 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8835 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8836 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8837 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8838 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8839 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8840 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8841 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8842 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8843 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8845 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8846 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8847 cgrad ghalf=0.5d0*ggg1(ll)
8849 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8850 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8851 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8852 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8853 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8854 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8855 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8856 cgrad ghalf=0.5d0*ggg2(ll)
8858 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8859 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8860 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8861 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8862 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8863 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8868 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8869 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8874 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8875 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8881 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8886 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8890 cd write (2,*) iii,g_corr5_loc(iii)
8893 cd write (2,*) 'ekont',ekont
8894 cd write (iout,*) 'eello5',ekont*eel5
8897 c--------------------------------------------------------------------------
8898 double precision function eello6(i,j,k,l,jj,kk)
8899 implicit real*8 (a-h,o-z)
8900 include 'DIMENSIONS'
8901 include 'COMMON.IOUNITS'
8902 include 'COMMON.CHAIN'
8903 include 'COMMON.DERIV'
8904 include 'COMMON.INTERACT'
8905 include 'COMMON.CONTACTS'
8906 include 'COMMON.TORSION'
8907 include 'COMMON.VAR'
8908 include 'COMMON.GEO'
8909 include 'COMMON.FFIELD'
8910 double precision ggg1(3),ggg2(3)
8911 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8916 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8924 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8925 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8929 derx(lll,kkk,iii)=0.0d0
8933 cd eij=facont_hb(jj,i)
8934 cd ekl=facont_hb(kk,k)
8940 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8941 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8942 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8943 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8944 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8945 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8947 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8948 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8949 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8950 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8951 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8952 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8956 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8958 C If turn contributions are considered, they will be handled separately.
8959 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8960 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8961 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8962 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8963 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8964 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8965 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8967 if (j.lt.nres-1) then
8974 if (l.lt.nres-1) then
8982 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8983 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8984 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8985 cgrad ghalf=0.5d0*ggg1(ll)
8987 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8988 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8989 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8990 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8991 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8992 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8993 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8994 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8995 cgrad ghalf=0.5d0*ggg2(ll)
8996 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8998 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8999 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9000 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9001 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9002 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9003 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9008 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9009 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9014 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9015 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9021 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9026 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9030 cd write (2,*) iii,g_corr6_loc(iii)
9033 cd write (2,*) 'ekont',ekont
9034 cd write (iout,*) 'eello6',ekont*eel6
9037 c--------------------------------------------------------------------------
9038 double precision function eello6_graph1(i,j,k,l,imat,swap)
9039 implicit real*8 (a-h,o-z)
9040 include 'DIMENSIONS'
9041 include 'COMMON.IOUNITS'
9042 include 'COMMON.CHAIN'
9043 include 'COMMON.DERIV'
9044 include 'COMMON.INTERACT'
9045 include 'COMMON.CONTACTS'
9046 include 'COMMON.TORSION'
9047 include 'COMMON.VAR'
9048 include 'COMMON.GEO'
9049 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9053 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9055 C Parallel Antiparallel C
9061 C \ j|/k\| / \ |/k\|l / C
9066 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9067 itk=itortyp(itype(k))
9068 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9069 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9070 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9071 call transpose2(EUgC(1,1,k),auxmat(1,1))
9072 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9073 vv1(1)=pizda1(1,1)-pizda1(2,2)
9074 vv1(2)=pizda1(1,2)+pizda1(2,1)
9075 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9076 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
9077 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
9078 s5=scalar2(vv(1),Dtobr2(1,i))
9079 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9080 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9081 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9082 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9083 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9084 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9085 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9086 & +scalar2(vv(1),Dtobr2der(1,i)))
9087 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9088 vv1(1)=pizda1(1,1)-pizda1(2,2)
9089 vv1(2)=pizda1(1,2)+pizda1(2,1)
9090 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
9091 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
9093 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9094 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9095 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9096 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9097 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9099 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9100 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9101 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9102 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9103 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9105 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9106 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9107 vv1(1)=pizda1(1,1)-pizda1(2,2)
9108 vv1(2)=pizda1(1,2)+pizda1(2,1)
9109 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9110 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9111 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
9112 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9121 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9122 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9123 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9124 call transpose2(EUgC(1,1,k),auxmat(1,1))
9125 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9127 vv1(1)=pizda1(1,1)-pizda1(2,2)
9128 vv1(2)=pizda1(1,2)+pizda1(2,1)
9129 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9130 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
9131 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
9132 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
9133 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
9134 s5=scalar2(vv(1),Dtobr2(1,i))
9135 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9141 c----------------------------------------------------------------------------
9142 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
9143 implicit real*8 (a-h,o-z)
9144 include 'DIMENSIONS'
9145 include 'COMMON.IOUNITS'
9146 include 'COMMON.CHAIN'
9147 include 'COMMON.DERIV'
9148 include 'COMMON.INTERACT'
9149 include 'COMMON.CONTACTS'
9150 include 'COMMON.TORSION'
9151 include 'COMMON.VAR'
9152 include 'COMMON.GEO'
9154 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9155 & auxvec1(2),auxvec2(2),auxmat1(2,2)
9158 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9160 C Parallel Antiparallel C
9166 C \ j|/k\| \ |/k\|l C
9171 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9172 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9173 C AL 7/4/01 s1 would occur in the sixth-order moment,
9174 C but not in a cluster cumulant
9176 s1=dip(1,jj,i)*dip(1,kk,k)
9178 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9179 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9180 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9181 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9182 call transpose2(EUg(1,1,k),auxmat(1,1))
9183 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9184 vv(1)=pizda(1,1)-pizda(2,2)
9185 vv(2)=pizda(1,2)+pizda(2,1)
9186 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9187 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9189 eello6_graph2=-(s1+s2+s3+s4)
9191 eello6_graph2=-(s2+s3+s4)
9194 C Derivatives in gamma(i-1)
9197 s1=dipderg(1,jj,i)*dip(1,kk,k)
9199 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9200 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9201 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9202 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9204 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9206 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9208 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9210 C Derivatives in gamma(k-1)
9212 s1=dip(1,jj,i)*dipderg(1,kk,k)
9214 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9215 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9216 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9217 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9218 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9219 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9220 vv(1)=pizda(1,1)-pizda(2,2)
9221 vv(2)=pizda(1,2)+pizda(2,1)
9222 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9224 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9226 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9228 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9229 C Derivatives in gamma(j-1) or gamma(l-1)
9232 s1=dipderg(3,jj,i)*dip(1,kk,k)
9234 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9235 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9236 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9237 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9238 vv(1)=pizda(1,1)-pizda(2,2)
9239 vv(2)=pizda(1,2)+pizda(2,1)
9240 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9243 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9245 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9248 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9249 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9251 C Derivatives in gamma(l-1) or gamma(j-1)
9254 s1=dip(1,jj,i)*dipderg(3,kk,k)
9256 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9257 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9258 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9259 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9260 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9261 vv(1)=pizda(1,1)-pizda(2,2)
9262 vv(2)=pizda(1,2)+pizda(2,1)
9263 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9266 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9268 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9271 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9272 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9274 C Cartesian derivatives.
9276 write (2,*) 'In eello6_graph2'
9278 write (2,*) 'iii=',iii
9280 write (2,*) 'kkk=',kkk
9282 write (2,'(3(2f10.5),5x)')
9283 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9293 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9295 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9298 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9300 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9301 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9303 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9304 call transpose2(EUg(1,1,k),auxmat(1,1))
9305 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9307 vv(1)=pizda(1,1)-pizda(2,2)
9308 vv(2)=pizda(1,2)+pizda(2,1)
9309 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9310 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9312 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9314 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9317 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9319 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9326 c----------------------------------------------------------------------------
9327 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9328 implicit real*8 (a-h,o-z)
9329 include 'DIMENSIONS'
9330 include 'COMMON.IOUNITS'
9331 include 'COMMON.CHAIN'
9332 include 'COMMON.DERIV'
9333 include 'COMMON.INTERACT'
9334 include 'COMMON.CONTACTS'
9335 include 'COMMON.TORSION'
9336 include 'COMMON.VAR'
9337 include 'COMMON.GEO'
9338 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9340 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9342 C Parallel Antiparallel C
9348 C j|/k\| / |/k\|l / C
9353 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9355 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9356 C energy moment and not to the cluster cumulant.
9357 iti=itortyp(itype(i))
9358 if (j.lt.nres-1) then
9359 itj1=itortyp(itype(j+1))
9363 itk=itortyp(itype(k))
9364 itk1=itortyp(itype(k+1))
9365 if (l.lt.nres-1) then
9366 itl1=itortyp(itype(l+1))
9371 s1=dip(4,jj,i)*dip(4,kk,k)
9373 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
9374 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9375 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
9376 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9377 call transpose2(EE(1,1,itk),auxmat(1,1))
9378 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9379 vv(1)=pizda(1,1)+pizda(2,2)
9380 vv(2)=pizda(2,1)-pizda(1,2)
9381 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9382 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9383 cd & "sum",-(s2+s3+s4)
9385 eello6_graph3=-(s1+s2+s3+s4)
9387 eello6_graph3=-(s2+s3+s4)
9390 C Derivatives in gamma(k-1)
9391 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
9392 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9393 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9394 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9395 C Derivatives in gamma(l-1)
9396 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
9397 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9398 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9399 vv(1)=pizda(1,1)+pizda(2,2)
9400 vv(2)=pizda(2,1)-pizda(1,2)
9401 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9402 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9403 C Cartesian derivatives.
9409 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9411 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9414 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9416 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9417 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9419 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9420 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9422 vv(1)=pizda(1,1)+pizda(2,2)
9423 vv(2)=pizda(2,1)-pizda(1,2)
9424 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9426 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9428 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9431 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9433 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9435 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9441 c----------------------------------------------------------------------------
9442 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9443 implicit real*8 (a-h,o-z)
9444 include 'DIMENSIONS'
9445 include 'COMMON.IOUNITS'
9446 include 'COMMON.CHAIN'
9447 include 'COMMON.DERIV'
9448 include 'COMMON.INTERACT'
9449 include 'COMMON.CONTACTS'
9450 include 'COMMON.TORSION'
9451 include 'COMMON.VAR'
9452 include 'COMMON.GEO'
9453 include 'COMMON.FFIELD'
9454 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9455 & auxvec1(2),auxmat1(2,2)
9457 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9459 C Parallel Antiparallel C
9465 C \ j|/k\| \ |/k\|l C
9470 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9472 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9473 C energy moment and not to the cluster cumulant.
9474 cd write (2,*) 'eello_graph4: wturn6',wturn6
9475 iti=itortyp(itype(i))
9476 itj=itortyp(itype(j))
9477 if (j.lt.nres-1) then
9478 itj1=itortyp(itype(j+1))
9482 itk=itortyp(itype(k))
9483 if (k.lt.nres-1) then
9484 itk1=itortyp(itype(k+1))
9488 itl=itortyp(itype(l))
9489 if (l.lt.nres-1) then
9490 itl1=itortyp(itype(l+1))
9494 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9495 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9496 cd & ' itl',itl,' itl1',itl1
9499 s1=dip(3,jj,i)*dip(3,kk,k)
9501 s1=dip(2,jj,j)*dip(2,kk,l)
9504 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9505 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9507 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9508 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9510 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9511 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9513 call transpose2(EUg(1,1,k),auxmat(1,1))
9514 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9515 vv(1)=pizda(1,1)-pizda(2,2)
9516 vv(2)=pizda(2,1)+pizda(1,2)
9517 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9518 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9520 eello6_graph4=-(s1+s2+s3+s4)
9522 eello6_graph4=-(s2+s3+s4)
9524 C Derivatives in gamma(i-1)
9528 s1=dipderg(2,jj,i)*dip(3,kk,k)
9530 s1=dipderg(4,jj,j)*dip(2,kk,l)
9533 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9535 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9536 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9538 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9539 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9541 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9542 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9543 cd write (2,*) 'turn6 derivatives'
9545 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9547 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9551 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9553 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9557 C Derivatives in gamma(k-1)
9560 s1=dip(3,jj,i)*dipderg(2,kk,k)
9562 s1=dip(2,jj,j)*dipderg(4,kk,l)
9565 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9566 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9568 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9569 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9571 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9572 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9574 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9575 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9576 vv(1)=pizda(1,1)-pizda(2,2)
9577 vv(2)=pizda(2,1)+pizda(1,2)
9578 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9579 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9581 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9583 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9587 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9589 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9592 C Derivatives in gamma(j-1) or gamma(l-1)
9593 if (l.eq.j+1 .and. l.gt.1) then
9594 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9595 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9596 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9597 vv(1)=pizda(1,1)-pizda(2,2)
9598 vv(2)=pizda(2,1)+pizda(1,2)
9599 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9600 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9601 else if (j.gt.1) then
9602 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9603 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9604 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9605 vv(1)=pizda(1,1)-pizda(2,2)
9606 vv(2)=pizda(2,1)+pizda(1,2)
9607 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9608 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9609 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9611 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9614 C Cartesian derivatives.
9621 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9623 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9627 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9629 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9633 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9635 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9637 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9638 & b1(1,j+1),auxvec(1))
9639 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9641 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9642 & b1(1,l+1),auxvec(1))
9643 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9645 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9647 vv(1)=pizda(1,1)-pizda(2,2)
9648 vv(2)=pizda(2,1)+pizda(1,2)
9649 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9651 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9653 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9656 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9659 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9662 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9664 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9666 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9670 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9672 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9675 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9677 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9685 c----------------------------------------------------------------------------
9686 double precision function eello_turn6(i,jj,kk)
9687 implicit real*8 (a-h,o-z)
9688 include 'DIMENSIONS'
9689 include 'COMMON.IOUNITS'
9690 include 'COMMON.CHAIN'
9691 include 'COMMON.DERIV'
9692 include 'COMMON.INTERACT'
9693 include 'COMMON.CONTACTS'
9694 include 'COMMON.TORSION'
9695 include 'COMMON.VAR'
9696 include 'COMMON.GEO'
9697 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9698 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9700 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9701 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9702 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9703 C the respective energy moment and not to the cluster cumulant.
9712 iti=itortyp(itype(i))
9713 itk=itortyp(itype(k))
9714 itk1=itortyp(itype(k+1))
9715 itl=itortyp(itype(l))
9716 itj=itortyp(itype(j))
9717 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9718 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9719 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9724 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9726 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9730 derx_turn(lll,kkk,iii)=0.0d0
9737 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9739 cd write (2,*) 'eello6_5',eello6_5
9741 call transpose2(AEA(1,1,1),auxmat(1,1))
9742 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9743 ss1=scalar2(Ub2(1,i+2),b1(1,l))
9744 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9746 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9747 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9748 s2 = scalar2(b1(1,k),vtemp1(1))
9750 call transpose2(AEA(1,1,2),atemp(1,1))
9751 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9752 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9753 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9755 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9756 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9757 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9759 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9760 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9761 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9762 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9763 ss13 = scalar2(b1(1,k),vtemp4(1))
9764 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9766 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9772 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9773 C Derivatives in gamma(i+2)
9777 call transpose2(AEA(1,1,1),auxmatd(1,1))
9778 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9779 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9780 call transpose2(AEAderg(1,1,2),atempd(1,1))
9781 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9782 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9784 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9785 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9786 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9792 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9793 C Derivatives in gamma(i+3)
9795 call transpose2(AEA(1,1,1),auxmatd(1,1))
9796 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9797 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
9798 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9800 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
9801 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9802 s2d = scalar2(b1(1,k),vtemp1d(1))
9804 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9805 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9807 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9809 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9810 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9811 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9819 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9820 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9822 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9823 & -0.5d0*ekont*(s2d+s12d)
9825 C Derivatives in gamma(i+4)
9826 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9827 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9828 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9830 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9831 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9832 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9840 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9842 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9844 C Derivatives in gamma(i+5)
9846 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9847 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9848 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9850 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
9851 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9852 s2d = scalar2(b1(1,k),vtemp1d(1))
9854 call transpose2(AEA(1,1,2),atempd(1,1))
9855 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9856 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9858 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9859 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9861 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9862 ss13d = scalar2(b1(1,k),vtemp4d(1))
9863 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9871 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9872 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9874 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9875 & -0.5d0*ekont*(s2d+s12d)
9877 C Cartesian derivatives
9882 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9883 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9884 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9886 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9887 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9889 s2d = scalar2(b1(1,k),vtemp1d(1))
9891 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9892 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9893 s8d = -(atempd(1,1)+atempd(2,2))*
9894 & scalar2(cc(1,1,itl),vtemp2(1))
9896 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9898 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9899 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9906 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9909 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9913 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9914 & - 0.5d0*(s8d+s12d)
9916 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9925 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9927 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9928 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9929 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9930 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9931 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9933 ss13d = scalar2(b1(1,k),vtemp4d(1))
9934 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9935 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9939 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9940 cd & 16*eel_turn6_num
9942 if (j.lt.nres-1) then
9949 if (l.lt.nres-1) then
9957 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9958 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9959 cgrad ghalf=0.5d0*ggg1(ll)
9961 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9962 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9963 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9964 & +ekont*derx_turn(ll,2,1)
9965 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9966 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9967 & +ekont*derx_turn(ll,4,1)
9968 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9969 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9970 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9971 cgrad ghalf=0.5d0*ggg2(ll)
9973 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9974 & +ekont*derx_turn(ll,2,2)
9975 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9976 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9977 & +ekont*derx_turn(ll,4,2)
9978 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9979 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9980 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9985 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9990 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9996 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10001 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10005 cd write (2,*) iii,g_corr6_loc(iii)
10007 eello_turn6=ekont*eel_turn6
10008 cd write (2,*) 'ekont',ekont
10009 cd write (2,*) 'eel_turn6',ekont*eel_turn6
10013 C-----------------------------------------------------------------------------
10014 double precision function scalar(u,v)
10015 !DIR$ INLINEALWAYS scalar
10017 cDEC$ ATTRIBUTES FORCEINLINE::scalar
10020 double precision u(3),v(3)
10021 cd double precision sc
10029 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
10032 crc-------------------------------------------------
10033 SUBROUTINE MATVEC2(A1,V1,V2)
10034 !DIR$ INLINEALWAYS MATVEC2
10036 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10038 implicit real*8 (a-h,o-z)
10039 include 'DIMENSIONS'
10040 DIMENSION A1(2,2),V1(2),V2(2)
10044 c 3 VI=VI+A1(I,K)*V1(K)
10048 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10049 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10054 C---------------------------------------
10055 SUBROUTINE MATMAT2(A1,A2,A3)
10057 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10059 implicit real*8 (a-h,o-z)
10060 include 'DIMENSIONS'
10061 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10062 c DIMENSION AI3(2,2)
10066 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10072 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10073 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10074 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10075 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10083 c-------------------------------------------------------------------------
10084 double precision function scalar2(u,v)
10085 !DIR$ INLINEALWAYS scalar2
10087 double precision u(2),v(2)
10088 double precision sc
10090 scalar2=u(1)*v(1)+u(2)*v(2)
10094 C-----------------------------------------------------------------------------
10096 subroutine transpose2(a,at)
10097 !DIR$ INLINEALWAYS transpose2
10099 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
10102 double precision a(2,2),at(2,2)
10109 c--------------------------------------------------------------------------
10110 subroutine transpose(n,a,at)
10113 double precision a(n,n),at(n,n)
10121 C---------------------------------------------------------------------------
10122 subroutine prodmat3(a1,a2,kk,transp,prod)
10123 !DIR$ INLINEALWAYS prodmat3
10125 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
10129 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
10131 crc double precision auxmat(2,2),prod_(2,2)
10134 crc call transpose2(kk(1,1),auxmat(1,1))
10135 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10136 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10138 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
10139 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10140 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
10141 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10142 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
10143 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10144 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
10145 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10148 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10149 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10151 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
10152 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10153 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
10154 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10155 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
10156 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10157 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
10158 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10161 c call transpose2(a2(1,1),a2t(1,1))
10164 crc print *,((prod_(i,j),i=1,2),j=1,2)
10165 crc print *,((prod(i,j),i=1,2),j=1,2)
10169 CCC----------------------------------------------
10170 subroutine Eliptransfer(eliptran)
10171 implicit real*8 (a-h,o-z)
10172 include 'DIMENSIONS'
10173 include 'COMMON.GEO'
10174 include 'COMMON.VAR'
10175 include 'COMMON.LOCAL'
10176 include 'COMMON.CHAIN'
10177 include 'COMMON.DERIV'
10178 include 'COMMON.NAMES'
10179 include 'COMMON.INTERACT'
10180 include 'COMMON.IOUNITS'
10181 include 'COMMON.CALC'
10182 include 'COMMON.CONTROL'
10183 include 'COMMON.SPLITELE'
10184 include 'COMMON.SBRIDGE'
10185 C this is done by Adasko
10186 C print *,"wchodze"
10187 C structure of box:
10189 C--bordliptop-- buffore starts
10190 C--bufliptop--- here true lipid starts
10192 C--buflipbot--- lipid ends buffore starts
10193 C--bordlipbot--buffore ends
10195 do i=ilip_start,ilip_end
10197 if (itype(i).eq.ntyp1) cycle
10199 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
10200 if (positi.le.0) positi=positi+boxzsize
10202 C first for peptide groups
10203 c for each residue check if it is in lipid or lipid water border area
10204 if ((positi.gt.bordlipbot)
10205 &.and.(positi.lt.bordliptop)) then
10206 C the energy transfer exist
10207 if (positi.lt.buflipbot) then
10208 C what fraction I am in
10210 & ((positi-bordlipbot)/lipbufthick)
10211 C lipbufthick is thickenes of lipid buffore
10212 sslip=sscalelip(fracinbuf)
10213 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10214 eliptran=eliptran+sslip*pepliptran
10215 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10216 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10217 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10219 C print *,"doing sccale for lower part"
10220 C print *,i,sslip,fracinbuf,ssgradlip
10221 elseif (positi.gt.bufliptop) then
10222 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
10223 sslip=sscalelip(fracinbuf)
10224 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10225 eliptran=eliptran+sslip*pepliptran
10226 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10227 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10228 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10229 C print *, "doing sscalefor top part"
10230 C print *,i,sslip,fracinbuf,ssgradlip
10232 eliptran=eliptran+pepliptran
10233 C print *,"I am in true lipid"
10236 C eliptran=elpitran+0.0 ! I am in water
10239 C print *, "nic nie bylo w lipidzie?"
10240 C now multiply all by the peptide group transfer factor
10241 C eliptran=eliptran*pepliptran
10242 C now the same for side chains
10244 do i=ilip_start,ilip_end
10245 if (itype(i).eq.ntyp1) cycle
10246 positi=(mod(c(3,i+nres),boxzsize))
10247 if (positi.le.0) positi=positi+boxzsize
10248 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
10249 c for each residue check if it is in lipid or lipid water border area
10250 C respos=mod(c(3,i+nres),boxzsize)
10251 C print *,positi,bordlipbot,buflipbot
10252 if ((positi.gt.bordlipbot)
10253 & .and.(positi.lt.bordliptop)) then
10254 C the energy transfer exist
10255 if (positi.lt.buflipbot) then
10257 & ((positi-bordlipbot)/lipbufthick)
10258 C lipbufthick is thickenes of lipid buffore
10259 sslip=sscalelip(fracinbuf)
10260 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10261 eliptran=eliptran+sslip*liptranene(itype(i))
10262 gliptranx(3,i)=gliptranx(3,i)
10263 &+ssgradlip*liptranene(itype(i))
10264 gliptranc(3,i-1)= gliptranc(3,i-1)
10265 &+ssgradlip*liptranene(itype(i))
10266 C print *,"doing sccale for lower part"
10267 elseif (positi.gt.bufliptop) then
10269 &((bordliptop-positi)/lipbufthick)
10270 sslip=sscalelip(fracinbuf)
10271 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10272 eliptran=eliptran+sslip*liptranene(itype(i))
10273 gliptranx(3,i)=gliptranx(3,i)
10274 &+ssgradlip*liptranene(itype(i))
10275 gliptranc(3,i-1)= gliptranc(3,i-1)
10276 &+ssgradlip*liptranene(itype(i))
10277 C print *, "doing sscalefor top part",sslip,fracinbuf
10279 eliptran=eliptran+liptranene(itype(i))
10280 C print *,"I am in true lipid"
10282 endif ! if in lipid or buffor
10284 C eliptran=elpitran+0.0 ! I am in water
10288 C---------------------------------------------------------
10289 C AFM soubroutine for constant force
10290 subroutine AFMforce(Eafmforce)
10291 implicit real*8 (a-h,o-z)
10292 include 'DIMENSIONS'
10293 include 'COMMON.GEO'
10294 include 'COMMON.VAR'
10295 include 'COMMON.LOCAL'
10296 include 'COMMON.CHAIN'
10297 include 'COMMON.DERIV'
10298 include 'COMMON.NAMES'
10299 include 'COMMON.INTERACT'
10300 include 'COMMON.IOUNITS'
10301 include 'COMMON.CALC'
10302 include 'COMMON.CONTROL'
10303 include 'COMMON.SPLITELE'
10304 include 'COMMON.SBRIDGE'
10309 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10310 dist=dist+diffafm(i)**2
10313 Eafmforce=-forceAFMconst*(dist-distafminit)
10315 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
10316 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
10318 C print *,'AFM',Eafmforce
10321 C---------------------------------------------------------
10322 C AFM subroutine with pseudoconstant velocity
10323 subroutine AFMvel(Eafmforce)
10324 implicit real*8 (a-h,o-z)
10325 include 'DIMENSIONS'
10326 include 'COMMON.GEO'
10327 include 'COMMON.VAR'
10328 include 'COMMON.LOCAL'
10329 include 'COMMON.CHAIN'
10330 include 'COMMON.DERIV'
10331 include 'COMMON.NAMES'
10332 include 'COMMON.INTERACT'
10333 include 'COMMON.IOUNITS'
10334 include 'COMMON.CALC'
10335 include 'COMMON.CONTROL'
10336 include 'COMMON.SPLITELE'
10337 include 'COMMON.SBRIDGE'
10339 C Only for check grad COMMENT if not used for checkgrad
10341 C--------------------------------------------------------
10342 C print *,"wchodze"
10346 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10347 dist=dist+diffafm(i)**2
10350 Eafmforce=0.5d0*forceAFMconst
10351 & *(distafminit+totTafm*velAFMconst-dist)**2
10352 C Eafmforce=-forceAFMconst*(dist-distafminit)
10354 gradafm(i,afmend-1)=-forceAFMconst*
10355 &(distafminit+totTafm*velAFMconst-dist)
10357 gradafm(i,afmbeg-1)=forceAFMconst*
10358 &(distafminit+totTafm*velAFMconst-dist)
10361 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist