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
5657 c print *,i,itype(i-1),itype(i),itype(i-2)
5658 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5659 & .or.itype(i).eq.ntyp1) cycle
5660 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
5662 if (iabs(itype(i+1)).eq.20) iblock=2
5663 if (iabs(itype(i+1)).ne.20) iblock=1
5667 theti2=0.5d0*theta(i)
5668 ityp2=ithetyp((itype(i-1)))
5670 coskt(k)=dcos(k*theti2)
5671 sinkt(k)=dsin(k*theti2)
5673 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5676 if (phii.ne.phii) phii=150.0
5680 ityp1=ithetyp((itype(i-2)))
5681 C propagation of chirality for glycine type
5683 cosph1(k)=dcos(k*phii)
5684 sinph1(k)=dsin(k*phii)
5694 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5697 if (phii1.ne.phii1) phii1=150.0
5702 ityp3=ithetyp((itype(i)))
5704 cosph2(k)=dcos(k*phii1)
5705 sinph2(k)=dsin(k*phii1)
5715 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5718 ccl=cosph1(l)*cosph2(k-l)
5719 ssl=sinph1(l)*sinph2(k-l)
5720 scl=sinph1(l)*cosph2(k-l)
5721 csl=cosph1(l)*sinph2(k-l)
5722 cosph1ph2(l,k)=ccl-ssl
5723 cosph1ph2(k,l)=ccl+ssl
5724 sinph1ph2(l,k)=scl+csl
5725 sinph1ph2(k,l)=scl-csl
5729 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5730 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5731 write (iout,*) "coskt and sinkt"
5733 write (iout,*) k,coskt(k),sinkt(k)
5737 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5738 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5741 & write (iout,*) "k",k,"
5742 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5743 & " ethetai",ethetai
5746 write (iout,*) "cosph and sinph"
5748 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5750 write (iout,*) "cosph1ph2 and sinph2ph2"
5753 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5754 & sinph1ph2(l,k),sinph1ph2(k,l)
5757 write(iout,*) "ethetai",ethetai
5761 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5762 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5763 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5764 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5765 ethetai=ethetai+sinkt(m)*aux
5766 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5767 dephii=dephii+k*sinkt(m)*(
5768 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5769 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5770 dephii1=dephii1+k*sinkt(m)*(
5771 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5772 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5774 & write (iout,*) "m",m," k",k," bbthet",
5775 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5776 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5777 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5778 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5782 & write(iout,*) "ethetai",ethetai
5786 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5787 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5788 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5789 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5790 ethetai=ethetai+sinkt(m)*aux
5791 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5792 dephii=dephii+l*sinkt(m)*(
5793 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5794 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5795 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5796 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5797 dephii1=dephii1+(k-l)*sinkt(m)*(
5798 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5799 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5800 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5801 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5803 write (iout,*) "m",m," k",k," l",l," ffthet",
5804 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5805 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5806 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5807 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5808 & " ethetai",ethetai
5809 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5810 & cosph1ph2(k,l)*sinkt(m),
5811 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5819 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5820 & i,theta(i)*rad2deg,phii*rad2deg,
5821 & phii1*rad2deg,ethetai
5823 etheta=etheta+ethetai
5824 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5825 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5826 gloc(nphi+i-2,icg)=wang*dethetai+gloc(nphi+i-2,icg)
5832 c-----------------------------------------------------------------------------
5833 subroutine esc(escloc)
5834 C Calculate the local energy of a side chain and its derivatives in the
5835 C corresponding virtual-bond valence angles THETA and the spherical angles
5837 implicit real*8 (a-h,o-z)
5838 include 'DIMENSIONS'
5839 include 'COMMON.GEO'
5840 include 'COMMON.LOCAL'
5841 include 'COMMON.VAR'
5842 include 'COMMON.INTERACT'
5843 include 'COMMON.DERIV'
5844 include 'COMMON.CHAIN'
5845 include 'COMMON.IOUNITS'
5846 include 'COMMON.NAMES'
5847 include 'COMMON.FFIELD'
5848 include 'COMMON.CONTROL'
5849 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5850 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5851 common /sccalc/ time11,time12,time112,theti,it,nlobit
5854 c write (iout,'(a)') 'ESC'
5855 do i=loc_start,loc_end
5857 if (it.eq.ntyp1) cycle
5858 if (it.eq.10) goto 1
5859 nlobit=nlob(iabs(it))
5860 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5861 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5862 theti=theta(i+1)-pipol
5867 if (x(2).gt.pi-delta) then
5871 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5873 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5874 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5876 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5877 & ddersc0(1),dersc(1))
5878 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5879 & ddersc0(3),dersc(3))
5881 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5883 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5884 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5885 & dersc0(2),esclocbi,dersc02)
5886 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5888 call splinthet(x(2),0.5d0*delta,ss,ssd)
5893 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5895 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5896 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5898 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5900 c write (iout,*) escloci
5901 else if (x(2).lt.delta) then
5905 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5907 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5908 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5910 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5911 & ddersc0(1),dersc(1))
5912 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5913 & ddersc0(3),dersc(3))
5915 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5917 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5918 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5919 & dersc0(2),esclocbi,dersc02)
5920 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5925 call splinthet(x(2),0.5d0*delta,ss,ssd)
5927 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5929 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5930 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5932 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5933 c write (iout,*) escloci
5935 call enesc(x,escloci,dersc,ddummy,.false.)
5938 escloc=escloc+escloci
5939 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5940 & 'escloc',i,escloci
5941 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5943 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5945 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5946 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5951 C---------------------------------------------------------------------------
5952 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5953 implicit real*8 (a-h,o-z)
5954 include 'DIMENSIONS'
5955 include 'COMMON.GEO'
5956 include 'COMMON.LOCAL'
5957 include 'COMMON.IOUNITS'
5958 common /sccalc/ time11,time12,time112,theti,it,nlobit
5959 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5960 double precision contr(maxlob,-1:1)
5962 c write (iout,*) 'it=',it,' nlobit=',nlobit
5966 if (mixed) ddersc(j)=0.0d0
5970 C Because of periodicity of the dependence of the SC energy in omega we have
5971 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5972 C To avoid underflows, first compute & store the exponents.
5980 z(k)=x(k)-censc(k,j,it)
5985 Axk=Axk+gaussc(l,k,j,it)*z(l)
5991 expfac=expfac+Ax(k,j,iii)*z(k)
5999 C As in the case of ebend, we want to avoid underflows in exponentiation and
6000 C subsequent NaNs and INFs in energy calculation.
6001 C Find the largest exponent
6005 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6009 cd print *,'it=',it,' emin=',emin
6011 C Compute the contribution to SC energy and derivatives
6016 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6017 if(adexp.ne.adexp) adexp=1.0
6020 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6022 cd print *,'j=',j,' expfac=',expfac
6023 escloc_i=escloc_i+expfac
6025 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6029 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6030 & +gaussc(k,2,j,it))*expfac
6037 dersc(1)=dersc(1)/cos(theti)**2
6038 ddersc(1)=ddersc(1)/cos(theti)**2
6041 escloci=-(dlog(escloc_i)-emin)
6043 dersc(j)=dersc(j)/escloc_i
6047 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6052 C------------------------------------------------------------------------------
6053 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6054 implicit real*8 (a-h,o-z)
6055 include 'DIMENSIONS'
6056 include 'COMMON.GEO'
6057 include 'COMMON.LOCAL'
6058 include 'COMMON.IOUNITS'
6059 common /sccalc/ time11,time12,time112,theti,it,nlobit
6060 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6061 double precision contr(maxlob)
6072 z(k)=x(k)-censc(k,j,it)
6078 Axk=Axk+gaussc(l,k,j,it)*z(l)
6084 expfac=expfac+Ax(k,j)*z(k)
6089 C As in the case of ebend, we want to avoid underflows in exponentiation and
6090 C subsequent NaNs and INFs in energy calculation.
6091 C Find the largest exponent
6094 if (emin.gt.contr(j)) emin=contr(j)
6098 C Compute the contribution to SC energy and derivatives
6102 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6103 escloc_i=escloc_i+expfac
6105 dersc(k)=dersc(k)+Ax(k,j)*expfac
6107 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6108 & +gaussc(1,2,j,it))*expfac
6112 dersc(1)=dersc(1)/cos(theti)**2
6113 dersc12=dersc12/cos(theti)**2
6114 escloci=-(dlog(escloc_i)-emin)
6116 dersc(j)=dersc(j)/escloc_i
6118 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6122 c----------------------------------------------------------------------------------
6123 subroutine esc(escloc)
6124 C Calculate the local energy of a side chain and its derivatives in the
6125 C corresponding virtual-bond valence angles THETA and the spherical angles
6126 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6127 C added by Urszula Kozlowska. 07/11/2007
6129 implicit real*8 (a-h,o-z)
6130 include 'DIMENSIONS'
6131 include 'COMMON.GEO'
6132 include 'COMMON.LOCAL'
6133 include 'COMMON.VAR'
6134 include 'COMMON.SCROT'
6135 include 'COMMON.INTERACT'
6136 include 'COMMON.DERIV'
6137 include 'COMMON.CHAIN'
6138 include 'COMMON.IOUNITS'
6139 include 'COMMON.NAMES'
6140 include 'COMMON.FFIELD'
6141 include 'COMMON.CONTROL'
6142 include 'COMMON.VECTORS'
6143 double precision x_prime(3),y_prime(3),z_prime(3)
6144 & , sumene,dsc_i,dp2_i,x(65),
6145 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6146 & de_dxx,de_dyy,de_dzz,de_dt
6147 double precision s1_t,s1_6_t,s2_t,s2_6_t
6149 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6150 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6151 & dt_dCi(3),dt_dCi1(3)
6152 common /sccalc/ time11,time12,time112,theti,it,nlobit
6155 do i=loc_start,loc_end
6156 if (itype(i).eq.ntyp1) cycle
6157 costtab(i+1) =dcos(theta(i+1))
6158 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6159 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6160 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6161 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6162 cosfac=dsqrt(cosfac2)
6163 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6164 sinfac=dsqrt(sinfac2)
6166 if (it.eq.10) goto 1
6168 C Compute the axes of tghe local cartesian coordinates system; store in
6169 c x_prime, y_prime and z_prime
6176 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6177 C & dc_norm(3,i+nres)
6179 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6180 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6183 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6186 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6187 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6188 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6189 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6190 c & " xy",scalar(x_prime(1),y_prime(1)),
6191 c & " xz",scalar(x_prime(1),z_prime(1)),
6192 c & " yy",scalar(y_prime(1),y_prime(1)),
6193 c & " yz",scalar(y_prime(1),z_prime(1)),
6194 c & " zz",scalar(z_prime(1),z_prime(1))
6196 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6197 C to local coordinate system. Store in xx, yy, zz.
6203 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6204 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6205 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6212 C Compute the energy of the ith side cbain
6214 c write (2,*) "xx",xx," yy",yy," zz",zz
6217 x(j) = sc_parmin(j,it)
6220 Cc diagnostics - remove later
6222 yy1 = dsin(alph(2))*dcos(omeg(2))
6223 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
6224 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6225 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6227 C," --- ", xx_w,yy_w,zz_w
6230 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6231 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6233 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6234 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6236 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6237 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6238 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6239 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6240 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6242 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6243 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6244 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6245 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6246 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6248 dsc_i = 0.743d0+x(61)
6250 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6251 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6252 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6253 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6254 s1=(1+x(63))/(0.1d0 + dscp1)
6255 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6256 s2=(1+x(65))/(0.1d0 + dscp2)
6257 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6258 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6259 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6260 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6262 c & dscp1,dscp2,sumene
6263 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6264 escloc = escloc + sumene
6265 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6270 C This section to check the numerical derivatives of the energy of ith side
6271 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6272 C #define DEBUG in the code to turn it on.
6274 write (2,*) "sumene =",sumene
6278 write (2,*) xx,yy,zz
6279 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6280 de_dxx_num=(sumenep-sumene)/aincr
6282 write (2,*) "xx+ sumene from enesc=",sumenep
6285 write (2,*) xx,yy,zz
6286 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6287 de_dyy_num=(sumenep-sumene)/aincr
6289 write (2,*) "yy+ sumene from enesc=",sumenep
6292 write (2,*) xx,yy,zz
6293 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6294 de_dzz_num=(sumenep-sumene)/aincr
6296 write (2,*) "zz+ sumene from enesc=",sumenep
6297 costsave=cost2tab(i+1)
6298 sintsave=sint2tab(i+1)
6299 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6300 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6301 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6302 de_dt_num=(sumenep-sumene)/aincr
6303 write (2,*) " t+ sumene from enesc=",sumenep
6304 cost2tab(i+1)=costsave
6305 sint2tab(i+1)=sintsave
6306 C End of diagnostics section.
6309 C Compute the gradient of esc
6311 c zz=zz*dsign(1.0,dfloat(itype(i)))
6312 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6313 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6314 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6315 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6316 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6317 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6318 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6319 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6320 pom1=(sumene3*sint2tab(i+1)+sumene1)
6321 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6322 pom2=(sumene4*cost2tab(i+1)+sumene2)
6323 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6324 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6325 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6326 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6328 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6329 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6330 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6332 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6333 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6334 & +(pom1+pom2)*pom_dx
6336 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6339 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6340 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6341 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6343 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6344 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6345 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6346 & +x(59)*zz**2 +x(60)*xx*zz
6347 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6348 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6349 & +(pom1-pom2)*pom_dy
6351 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6354 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6355 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6356 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6357 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6358 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6359 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6360 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6361 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6363 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6366 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6367 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6368 & +pom1*pom_dt1+pom2*pom_dt2
6370 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6375 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6376 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6377 cosfac2xx=cosfac2*xx
6378 sinfac2yy=sinfac2*yy
6380 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6382 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6384 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6385 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6386 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6387 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6388 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6389 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6390 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6391 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6392 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6393 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6397 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6398 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6399 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6400 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6403 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6404 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6405 dZZ_XYZ(k)=vbld_inv(i+nres)*
6406 & (z_prime(k)-zz*dC_norm(k,i+nres))
6408 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6409 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6413 dXX_Ctab(k,i)=dXX_Ci(k)
6414 dXX_C1tab(k,i)=dXX_Ci1(k)
6415 dYY_Ctab(k,i)=dYY_Ci(k)
6416 dYY_C1tab(k,i)=dYY_Ci1(k)
6417 dZZ_Ctab(k,i)=dZZ_Ci(k)
6418 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6419 dXX_XYZtab(k,i)=dXX_XYZ(k)
6420 dYY_XYZtab(k,i)=dYY_XYZ(k)
6421 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6425 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6426 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6427 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6428 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6429 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6431 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6432 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6433 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6434 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6435 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6436 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6437 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6438 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6440 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6441 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6443 C to check gradient call subroutine check_grad
6449 c------------------------------------------------------------------------------
6450 double precision function enesc(x,xx,yy,zz,cost2,sint2)
6452 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
6453 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6454 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6455 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6457 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6458 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6460 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6461 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6462 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6463 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6464 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6466 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6467 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6468 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6469 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6470 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6472 dsc_i = 0.743d0+x(61)
6474 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6475 & *(xx*cost2+yy*sint2))
6476 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6477 & *(xx*cost2-yy*sint2))
6478 s1=(1+x(63))/(0.1d0 + dscp1)
6479 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6480 s2=(1+x(65))/(0.1d0 + dscp2)
6481 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6482 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
6483 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
6488 c------------------------------------------------------------------------------
6489 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6491 C This procedure calculates two-body contact function g(rij) and its derivative:
6494 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6497 C where x=(rij-r0ij)/delta
6499 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6502 double precision rij,r0ij,eps0ij,fcont,fprimcont
6503 double precision x,x2,x4,delta
6507 if (x.lt.-1.0D0) then
6510 else if (x.le.1.0D0) then
6513 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6514 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6521 c------------------------------------------------------------------------------
6522 subroutine splinthet(theti,delta,ss,ssder)
6523 implicit real*8 (a-h,o-z)
6524 include 'DIMENSIONS'
6525 include 'COMMON.VAR'
6526 include 'COMMON.GEO'
6529 if (theti.gt.pipol) then
6530 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6532 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6537 c------------------------------------------------------------------------------
6538 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6540 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6541 double precision ksi,ksi2,ksi3,a1,a2,a3
6542 a1=fprim0*delta/(f1-f0)
6548 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6549 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6552 c------------------------------------------------------------------------------
6553 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6555 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6556 double precision ksi,ksi2,ksi3,a1,a2,a3
6561 a2=3*(f1x-f0x)-2*fprim0x*delta
6562 a3=fprim0x*delta-2*(f1x-f0x)
6563 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6566 C-----------------------------------------------------------------------------
6568 C-----------------------------------------------------------------------------
6569 subroutine etor(etors,edihcnstr)
6570 implicit real*8 (a-h,o-z)
6571 include 'DIMENSIONS'
6572 include 'COMMON.VAR'
6573 include 'COMMON.GEO'
6574 include 'COMMON.LOCAL'
6575 include 'COMMON.TORSION'
6576 include 'COMMON.INTERACT'
6577 include 'COMMON.DERIV'
6578 include 'COMMON.CHAIN'
6579 include 'COMMON.NAMES'
6580 include 'COMMON.IOUNITS'
6581 include 'COMMON.FFIELD'
6582 include 'COMMON.TORCNSTR'
6583 include 'COMMON.CONTROL'
6585 C Set lprn=.true. for debugging
6589 do i=iphi_start,iphi_end
6591 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6592 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6593 itori=itortyp(itype(i-2))
6594 itori1=itortyp(itype(i-1))
6597 C Proline-Proline pair is a special case...
6598 if (itori.eq.3 .and. itori1.eq.3) then
6599 if (phii.gt.-dwapi3) then
6601 fac=1.0D0/(1.0D0-cosphi)
6602 etorsi=v1(1,3,3)*fac
6603 etorsi=etorsi+etorsi
6604 etors=etors+etorsi-v1(1,3,3)
6605 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6606 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6609 v1ij=v1(j+1,itori,itori1)
6610 v2ij=v2(j+1,itori,itori1)
6613 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6614 if (energy_dec) etors_ii=etors_ii+
6615 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6616 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6620 v1ij=v1(j,itori,itori1)
6621 v2ij=v2(j,itori,itori1)
6624 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6625 if (energy_dec) etors_ii=etors_ii+
6626 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6627 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6630 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6633 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6634 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6635 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6636 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6637 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6639 ! 6/20/98 - dihedral angle constraints
6642 itori=idih_constr(i)
6645 if (difi.gt.drange(i)) then
6647 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6648 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6649 else if (difi.lt.-drange(i)) then
6651 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6652 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6654 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6655 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6657 ! write (iout,*) 'edihcnstr',edihcnstr
6660 c------------------------------------------------------------------------------
6661 subroutine etor_d(etors_d)
6665 c----------------------------------------------------------------------------
6667 subroutine etor(etors,edihcnstr)
6668 implicit real*8 (a-h,o-z)
6669 include 'DIMENSIONS'
6670 include 'COMMON.VAR'
6671 include 'COMMON.GEO'
6672 include 'COMMON.LOCAL'
6673 include 'COMMON.TORSION'
6674 include 'COMMON.INTERACT'
6675 include 'COMMON.DERIV'
6676 include 'COMMON.CHAIN'
6677 include 'COMMON.NAMES'
6678 include 'COMMON.IOUNITS'
6679 include 'COMMON.FFIELD'
6680 include 'COMMON.TORCNSTR'
6681 include 'COMMON.CONTROL'
6683 C Set lprn=.true. for debugging
6687 do i=iphi_start,iphi_end
6688 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6689 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6690 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6691 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6692 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6693 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6694 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6695 C For introducing the NH3+ and COO- group please check the etor_d for reference
6698 if (iabs(itype(i)).eq.20) then
6703 itori=itortyp(itype(i-2))
6704 itori1=itortyp(itype(i-1))
6707 C Regular cosine and sine terms
6708 do j=1,nterm(itori,itori1,iblock)
6709 v1ij=v1(j,itori,itori1,iblock)
6710 v2ij=v2(j,itori,itori1,iblock)
6713 etors=etors+v1ij*cosphi+v2ij*sinphi
6714 if (energy_dec) etors_ii=etors_ii+
6715 & v1ij*cosphi+v2ij*sinphi
6716 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6720 C E = SUM ----------------------------------- - v1
6721 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6723 cosphi=dcos(0.5d0*phii)
6724 sinphi=dsin(0.5d0*phii)
6725 do j=1,nlor(itori,itori1,iblock)
6726 vl1ij=vlor1(j,itori,itori1)
6727 vl2ij=vlor2(j,itori,itori1)
6728 vl3ij=vlor3(j,itori,itori1)
6729 pom=vl2ij*cosphi+vl3ij*sinphi
6730 pom1=1.0d0/(pom*pom+1.0d0)
6731 etors=etors+vl1ij*pom1
6732 if (energy_dec) etors_ii=etors_ii+
6735 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6737 C Subtract the constant term
6738 etors=etors-v0(itori,itori1,iblock)
6739 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6740 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6742 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6743 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6744 & (v1(j,itori,itori1,iblock),j=1,6),
6745 & (v2(j,itori,itori1,iblock),j=1,6)
6746 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6747 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6749 ! 6/20/98 - dihedral angle constraints
6751 c do i=1,ndih_constr
6752 do i=idihconstr_start,idihconstr_end
6753 itori=idih_constr(i)
6755 difi=pinorm(phii-phi0(i))
6756 if (difi.gt.drange(i)) then
6758 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6759 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6760 else if (difi.lt.-drange(i)) then
6762 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6763 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6767 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6768 cd & rad2deg*phi0(i), rad2deg*drange(i),
6769 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6771 cd write (iout,*) 'edihcnstr',edihcnstr
6774 c----------------------------------------------------------------------------
6775 subroutine etor_d(etors_d)
6776 C 6/23/01 Compute double torsional energy
6777 implicit real*8 (a-h,o-z)
6778 include 'DIMENSIONS'
6779 include 'COMMON.VAR'
6780 include 'COMMON.GEO'
6781 include 'COMMON.LOCAL'
6782 include 'COMMON.TORSION'
6783 include 'COMMON.INTERACT'
6784 include 'COMMON.DERIV'
6785 include 'COMMON.CHAIN'
6786 include 'COMMON.NAMES'
6787 include 'COMMON.IOUNITS'
6788 include 'COMMON.FFIELD'
6789 include 'COMMON.TORCNSTR'
6790 include 'COMMON.CONTROL'
6792 C Set lprn=.true. for debugging
6796 c write(iout,*) "a tu??"
6797 do i=iphid_start,iphid_end
6798 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6799 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6800 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6801 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6802 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6803 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6804 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6805 & (itype(i+1).eq.ntyp1)) cycle
6806 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6808 itori=itortyp(itype(i-2))
6809 itori1=itortyp(itype(i-1))
6810 itori2=itortyp(itype(i))
6816 if (iabs(itype(i+1)).eq.20) iblock=2
6817 C Iblock=2 Proline type
6818 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6819 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6820 C if (itype(i+1).eq.ntyp1) iblock=3
6821 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6822 C IS or IS NOT need for this
6823 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6824 C is (itype(i-3).eq.ntyp1) ntblock=2
6825 C ntblock is N-terminal blocking group
6827 C Regular cosine and sine terms
6828 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6829 C Example of changes for NH3+ blocking group
6830 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6831 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6832 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6833 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6834 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6835 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6836 cosphi1=dcos(j*phii)
6837 sinphi1=dsin(j*phii)
6838 cosphi2=dcos(j*phii1)
6839 sinphi2=dsin(j*phii1)
6840 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6841 & v2cij*cosphi2+v2sij*sinphi2
6842 if (energy_dec) etors_d_ii=etors_d_ii+
6843 & v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
6844 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6845 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6847 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6849 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6850 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6851 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6852 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6853 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6854 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6855 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6856 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6857 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6858 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6859 if (energy_dec) etors_d_ii=etors_d_ii+
6860 & v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6861 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6862 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6863 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6864 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6865 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6868 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6869 & 'etor_d',i,etors_d_ii
6870 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6871 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6876 c------------------------------------------------------------------------------
6877 subroutine eback_sc_corr(esccor)
6878 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6879 c conformational states; temporarily implemented as differences
6880 c between UNRES torsional potentials (dependent on three types of
6881 c residues) and the torsional potentials dependent on all 20 types
6882 c of residues computed from AM1 energy surfaces of terminally-blocked
6883 c amino-acid residues.
6884 implicit real*8 (a-h,o-z)
6885 include 'DIMENSIONS'
6886 include 'COMMON.VAR'
6887 include 'COMMON.GEO'
6888 include 'COMMON.LOCAL'
6889 include 'COMMON.TORSION'
6890 include 'COMMON.SCCOR'
6891 include 'COMMON.INTERACT'
6892 include 'COMMON.DERIV'
6893 include 'COMMON.CHAIN'
6894 include 'COMMON.NAMES'
6895 include 'COMMON.IOUNITS'
6896 include 'COMMON.FFIELD'
6897 include 'COMMON.CONTROL'
6899 C Set lprn=.true. for debugging
6902 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6904 do i=itau_start,itau_end
6905 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6907 isccori=isccortyp(itype(i-2))
6908 isccori1=isccortyp(itype(i-1))
6909 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6911 do intertyp=1,3 !intertyp
6912 cc Added 09 May 2012 (Adasko)
6913 cc Intertyp means interaction type of backbone mainchain correlation:
6914 c 1 = SC...Ca...Ca...Ca
6915 c 2 = Ca...Ca...Ca...SC
6916 c 3 = SC...Ca...Ca...SCi
6918 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6919 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6920 & (itype(i-1).eq.ntyp1)))
6921 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6922 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6923 & .or.(itype(i).eq.ntyp1)))
6924 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6925 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6926 & (itype(i-3).eq.ntyp1)))) cycle
6927 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6928 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6930 do j=1,nterm_sccor(isccori,isccori1)
6931 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6932 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6933 cosphi=dcos(j*tauangle(intertyp,i))
6934 sinphi=dsin(j*tauangle(intertyp,i))
6935 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6936 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6938 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6939 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6941 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6942 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6943 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6944 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6945 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6951 c----------------------------------------------------------------------------
6952 subroutine multibody(ecorr)
6953 C This subroutine calculates multi-body contributions to energy following
6954 C the idea of Skolnick et al. If side chains I and J make a contact and
6955 C at the same time side chains I+1 and J+1 make a contact, an extra
6956 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6957 implicit real*8 (a-h,o-z)
6958 include 'DIMENSIONS'
6959 include 'COMMON.IOUNITS'
6960 include 'COMMON.DERIV'
6961 include 'COMMON.INTERACT'
6962 include 'COMMON.CONTACTS'
6963 double precision gx(3),gx1(3)
6966 C Set lprn=.true. for debugging
6970 write (iout,'(a)') 'Contact function values:'
6972 write (iout,'(i2,20(1x,i2,f10.5))')
6973 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6988 num_conti=num_cont(i)
6989 num_conti1=num_cont(i1)
6994 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6995 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6996 cd & ' ishift=',ishift
6997 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6998 C The system gains extra energy.
6999 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7000 endif ! j1==j+-ishift
7009 c------------------------------------------------------------------------------
7010 double precision function esccorr(i,j,k,l,jj,kk)
7011 implicit real*8 (a-h,o-z)
7012 include 'DIMENSIONS'
7013 include 'COMMON.IOUNITS'
7014 include 'COMMON.DERIV'
7015 include 'COMMON.INTERACT'
7016 include 'COMMON.CONTACTS'
7017 double precision gx(3),gx1(3)
7022 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7023 C Calculate the multi-body contribution to energy.
7024 C Calculate multi-body contributions to the gradient.
7025 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7026 cd & k,l,(gacont(m,kk,k),m=1,3)
7028 gx(m) =ekl*gacont(m,jj,i)
7029 gx1(m)=eij*gacont(m,kk,k)
7030 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7031 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7032 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7033 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7037 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7042 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7048 c------------------------------------------------------------------------------
7049 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7050 C This subroutine calculates multi-body contributions to hydrogen-bonding
7051 implicit real*8 (a-h,o-z)
7052 include 'DIMENSIONS'
7053 include 'COMMON.IOUNITS'
7056 parameter (max_cont=maxconts)
7057 parameter (max_dim=26)
7058 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7059 double precision zapas(max_dim,maxconts,max_fg_procs),
7060 & zapas_recv(max_dim,maxconts,max_fg_procs)
7061 common /przechowalnia/ zapas
7062 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7063 & status_array(MPI_STATUS_SIZE,maxconts*2)
7065 include 'COMMON.SETUP'
7066 include 'COMMON.FFIELD'
7067 include 'COMMON.DERIV'
7068 include 'COMMON.INTERACT'
7069 include 'COMMON.CONTACTS'
7070 include 'COMMON.CONTROL'
7071 include 'COMMON.LOCAL'
7072 double precision gx(3),gx1(3),time00
7075 C Set lprn=.true. for debugging
7080 if (nfgtasks.le.1) goto 30
7082 write (iout,'(a)') 'Contact function values before RECEIVE:'
7084 write (iout,'(2i3,50(1x,i2,f5.2))')
7085 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7086 & j=1,num_cont_hb(i))
7090 do i=1,ntask_cont_from
7093 do i=1,ntask_cont_to
7096 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7098 C Make the list of contacts to send to send to other procesors
7099 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7101 do i=iturn3_start,iturn3_end
7102 c write (iout,*) "make contact list turn3",i," num_cont",
7104 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7106 do i=iturn4_start,iturn4_end
7107 c write (iout,*) "make contact list turn4",i," num_cont",
7109 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7113 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7115 do j=1,num_cont_hb(i)
7118 iproc=iint_sent_local(k,jjc,ii)
7119 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7120 if (iproc.gt.0) then
7121 ncont_sent(iproc)=ncont_sent(iproc)+1
7122 nn=ncont_sent(iproc)
7124 zapas(2,nn,iproc)=jjc
7125 zapas(3,nn,iproc)=facont_hb(j,i)
7126 zapas(4,nn,iproc)=ees0p(j,i)
7127 zapas(5,nn,iproc)=ees0m(j,i)
7128 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7129 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7130 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7131 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7132 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7133 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7134 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7135 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7136 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7137 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7138 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7139 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7140 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7141 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7142 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7143 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7144 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7145 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7146 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7147 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7148 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7155 & "Numbers of contacts to be sent to other processors",
7156 & (ncont_sent(i),i=1,ntask_cont_to)
7157 write (iout,*) "Contacts sent"
7158 do ii=1,ntask_cont_to
7160 iproc=itask_cont_to(ii)
7161 write (iout,*) nn," contacts to processor",iproc,
7162 & " of CONT_TO_COMM group"
7164 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7172 CorrelID1=nfgtasks+fg_rank+1
7174 C Receive the numbers of needed contacts from other processors
7175 do ii=1,ntask_cont_from
7176 iproc=itask_cont_from(ii)
7178 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7179 & FG_COMM,req(ireq),IERR)
7181 c write (iout,*) "IRECV ended"
7183 C Send the number of contacts needed by other processors
7184 do ii=1,ntask_cont_to
7185 iproc=itask_cont_to(ii)
7187 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7188 & FG_COMM,req(ireq),IERR)
7190 c write (iout,*) "ISEND ended"
7191 c write (iout,*) "number of requests (nn)",ireq
7194 & call MPI_Waitall(ireq,req,status_array,ierr)
7196 c & "Numbers of contacts to be received from other processors",
7197 c & (ncont_recv(i),i=1,ntask_cont_from)
7201 do ii=1,ntask_cont_from
7202 iproc=itask_cont_from(ii)
7204 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7205 c & " of CONT_TO_COMM group"
7209 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7210 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7211 c write (iout,*) "ireq,req",ireq,req(ireq)
7214 C Send the contacts to processors that need them
7215 do ii=1,ntask_cont_to
7216 iproc=itask_cont_to(ii)
7218 c write (iout,*) nn," contacts to processor",iproc,
7219 c & " of CONT_TO_COMM group"
7222 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7223 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7224 c write (iout,*) "ireq,req",ireq,req(ireq)
7226 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7230 c write (iout,*) "number of requests (contacts)",ireq
7231 c write (iout,*) "req",(req(i),i=1,4)
7234 & call MPI_Waitall(ireq,req,status_array,ierr)
7235 do iii=1,ntask_cont_from
7236 iproc=itask_cont_from(iii)
7239 write (iout,*) "Received",nn," contacts from processor",iproc,
7240 & " of CONT_FROM_COMM group"
7243 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7248 ii=zapas_recv(1,i,iii)
7249 c Flag the received contacts to prevent double-counting
7250 jj=-zapas_recv(2,i,iii)
7251 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7253 nnn=num_cont_hb(ii)+1
7256 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7257 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7258 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7259 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7260 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7261 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7262 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7263 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7264 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7265 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7266 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7267 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7268 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7269 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7270 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7271 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7272 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7273 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7274 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7275 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7276 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7277 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7278 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7279 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7284 write (iout,'(a)') 'Contact function values after receive:'
7286 write (iout,'(2i3,50(1x,i3,f5.2))')
7287 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7288 & j=1,num_cont_hb(i))
7295 write (iout,'(a)') 'Contact function values:'
7297 write (iout,'(2i3,50(1x,i3,f5.2))')
7298 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7299 & j=1,num_cont_hb(i))
7303 C Remove the loop below after debugging !!!
7310 C Calculate the local-electrostatic correlation terms
7311 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7313 num_conti=num_cont_hb(i)
7314 num_conti1=num_cont_hb(i+1)
7321 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7322 c & ' jj=',jj,' kk=',kk
7323 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7324 & .or. j.lt.0 .and. j1.gt.0) .and.
7325 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7326 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7327 C The system gains extra energy.
7328 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7329 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7330 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7332 else if (j1.eq.j) then
7333 C Contacts I-J and I-(J+1) occur simultaneously.
7334 C The system loses extra energy.
7335 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7340 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7341 c & ' jj=',jj,' kk=',kk
7343 C Contacts I-J and (I+1)-J occur simultaneously.
7344 C The system loses extra energy.
7345 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7352 c------------------------------------------------------------------------------
7353 subroutine add_hb_contact(ii,jj,itask)
7354 implicit real*8 (a-h,o-z)
7355 include "DIMENSIONS"
7356 include "COMMON.IOUNITS"
7359 parameter (max_cont=maxconts)
7360 parameter (max_dim=26)
7361 include "COMMON.CONTACTS"
7362 double precision zapas(max_dim,maxconts,max_fg_procs),
7363 & zapas_recv(max_dim,maxconts,max_fg_procs)
7364 common /przechowalnia/ zapas
7365 integer i,j,ii,jj,iproc,itask(4),nn
7366 c write (iout,*) "itask",itask
7369 if (iproc.gt.0) then
7370 do j=1,num_cont_hb(ii)
7372 c write (iout,*) "i",ii," j",jj," jjc",jjc
7374 ncont_sent(iproc)=ncont_sent(iproc)+1
7375 nn=ncont_sent(iproc)
7376 zapas(1,nn,iproc)=ii
7377 zapas(2,nn,iproc)=jjc
7378 zapas(3,nn,iproc)=facont_hb(j,ii)
7379 zapas(4,nn,iproc)=ees0p(j,ii)
7380 zapas(5,nn,iproc)=ees0m(j,ii)
7381 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7382 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7383 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7384 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7385 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7386 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7387 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7388 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7389 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7390 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7391 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7392 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7393 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7394 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7395 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7396 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7397 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7398 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7399 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7400 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7401 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7409 c------------------------------------------------------------------------------
7410 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7412 C This subroutine calculates multi-body contributions to hydrogen-bonding
7413 implicit real*8 (a-h,o-z)
7414 include 'DIMENSIONS'
7415 include 'COMMON.IOUNITS'
7418 parameter (max_cont=maxconts)
7419 parameter (max_dim=70)
7420 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7421 double precision zapas(max_dim,maxconts,max_fg_procs),
7422 & zapas_recv(max_dim,maxconts,max_fg_procs)
7423 common /przechowalnia/ zapas
7424 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7425 & status_array(MPI_STATUS_SIZE,maxconts*2)
7427 include 'COMMON.SETUP'
7428 include 'COMMON.FFIELD'
7429 include 'COMMON.DERIV'
7430 include 'COMMON.LOCAL'
7431 include 'COMMON.INTERACT'
7432 include 'COMMON.CONTACTS'
7433 include 'COMMON.CHAIN'
7434 include 'COMMON.CONTROL'
7435 double precision gx(3),gx1(3)
7436 integer num_cont_hb_old(maxres)
7438 double precision eello4,eello5,eelo6,eello_turn6
7439 external eello4,eello5,eello6,eello_turn6
7440 C Set lprn=.true. for debugging
7445 num_cont_hb_old(i)=num_cont_hb(i)
7449 if (nfgtasks.le.1) goto 30
7451 write (iout,'(a)') 'Contact function values before RECEIVE:'
7453 write (iout,'(2i3,50(1x,i2,f5.2))')
7454 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7455 & j=1,num_cont_hb(i))
7459 do i=1,ntask_cont_from
7462 do i=1,ntask_cont_to
7465 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7467 C Make the list of contacts to send to send to other procesors
7468 do i=iturn3_start,iturn3_end
7469 c write (iout,*) "make contact list turn3",i," num_cont",
7471 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7473 do i=iturn4_start,iturn4_end
7474 c write (iout,*) "make contact list turn4",i," num_cont",
7476 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7480 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7482 do j=1,num_cont_hb(i)
7485 iproc=iint_sent_local(k,jjc,ii)
7486 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7487 if (iproc.ne.0) then
7488 ncont_sent(iproc)=ncont_sent(iproc)+1
7489 nn=ncont_sent(iproc)
7491 zapas(2,nn,iproc)=jjc
7492 zapas(3,nn,iproc)=d_cont(j,i)
7496 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7501 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7509 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7520 & "Numbers of contacts to be sent to other processors",
7521 & (ncont_sent(i),i=1,ntask_cont_to)
7522 write (iout,*) "Contacts sent"
7523 do ii=1,ntask_cont_to
7525 iproc=itask_cont_to(ii)
7526 write (iout,*) nn," contacts to processor",iproc,
7527 & " of CONT_TO_COMM group"
7529 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7537 CorrelID1=nfgtasks+fg_rank+1
7539 C Receive the numbers of needed contacts from other processors
7540 do ii=1,ntask_cont_from
7541 iproc=itask_cont_from(ii)
7543 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7544 & FG_COMM,req(ireq),IERR)
7546 c write (iout,*) "IRECV ended"
7548 C Send the number of contacts needed by other processors
7549 do ii=1,ntask_cont_to
7550 iproc=itask_cont_to(ii)
7552 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7553 & FG_COMM,req(ireq),IERR)
7555 c write (iout,*) "ISEND ended"
7556 c write (iout,*) "number of requests (nn)",ireq
7559 & call MPI_Waitall(ireq,req,status_array,ierr)
7561 c & "Numbers of contacts to be received from other processors",
7562 c & (ncont_recv(i),i=1,ntask_cont_from)
7566 do ii=1,ntask_cont_from
7567 iproc=itask_cont_from(ii)
7569 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7570 c & " of CONT_TO_COMM group"
7574 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7575 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7576 c write (iout,*) "ireq,req",ireq,req(ireq)
7579 C Send the contacts to processors that need them
7580 do ii=1,ntask_cont_to
7581 iproc=itask_cont_to(ii)
7583 c write (iout,*) nn," contacts to processor",iproc,
7584 c & " of CONT_TO_COMM group"
7587 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7588 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7589 c write (iout,*) "ireq,req",ireq,req(ireq)
7591 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7595 c write (iout,*) "number of requests (contacts)",ireq
7596 c write (iout,*) "req",(req(i),i=1,4)
7599 & call MPI_Waitall(ireq,req,status_array,ierr)
7600 do iii=1,ntask_cont_from
7601 iproc=itask_cont_from(iii)
7604 write (iout,*) "Received",nn," contacts from processor",iproc,
7605 & " of CONT_FROM_COMM group"
7608 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7613 ii=zapas_recv(1,i,iii)
7614 c Flag the received contacts to prevent double-counting
7615 jj=-zapas_recv(2,i,iii)
7616 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7618 nnn=num_cont_hb(ii)+1
7621 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7625 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7630 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7638 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7647 write (iout,'(a)') 'Contact function values after receive:'
7649 write (iout,'(2i3,50(1x,i3,5f6.3))')
7650 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7651 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7658 write (iout,'(a)') 'Contact function values:'
7660 write (iout,'(2i3,50(1x,i2,5f6.3))')
7661 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7662 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7668 C Remove the loop below after debugging !!!
7675 C Calculate the dipole-dipole interaction energies
7676 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7677 do i=iatel_s,iatel_e+1
7678 num_conti=num_cont_hb(i)
7687 C Calculate the local-electrostatic correlation terms
7688 c write (iout,*) "gradcorr5 in eello5 before loop"
7690 c write (iout,'(i5,3f10.5)')
7691 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7693 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7694 c write (iout,*) "corr loop i",i
7696 num_conti=num_cont_hb(i)
7697 num_conti1=num_cont_hb(i+1)
7704 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7705 c & ' jj=',jj,' kk=',kk
7706 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7707 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7708 & .or. j.lt.0 .and. j1.gt.0) .and.
7709 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7710 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7711 C The system gains extra energy.
7713 sqd1=dsqrt(d_cont(jj,i))
7714 sqd2=dsqrt(d_cont(kk,i1))
7715 sred_geom = sqd1*sqd2
7716 IF (sred_geom.lt.cutoff_corr) THEN
7717 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7719 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7720 cd & ' jj=',jj,' kk=',kk
7721 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7722 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7724 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7725 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7728 cd write (iout,*) 'sred_geom=',sred_geom,
7729 cd & ' ekont=',ekont,' fprim=',fprimcont,
7730 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7731 cd write (iout,*) "g_contij",g_contij
7732 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7733 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7734 call calc_eello(i,jp,i+1,jp1,jj,kk)
7735 if (wcorr4.gt.0.0d0)
7736 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7737 if (energy_dec.and.wcorr4.gt.0.0d0)
7738 1 write (iout,'(a6,4i5,0pf7.3)')
7739 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7740 c write (iout,*) "gradcorr5 before eello5"
7742 c write (iout,'(i5,3f10.5)')
7743 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7745 if (wcorr5.gt.0.0d0)
7746 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7747 c write (iout,*) "gradcorr5 after eello5"
7749 c write (iout,'(i5,3f10.5)')
7750 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7752 if (energy_dec.and.wcorr5.gt.0.0d0)
7753 1 write (iout,'(a6,4i5,0pf7.3)')
7754 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7755 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7756 cd write(2,*)'ijkl',i,jp,i+1,jp1
7757 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7758 & .or. wturn6.eq.0.0d0))then
7759 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7760 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7761 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7762 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7763 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7764 cd & 'ecorr6=',ecorr6
7765 cd write (iout,'(4e15.5)') sred_geom,
7766 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7767 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7768 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7769 else if (wturn6.gt.0.0d0
7770 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7771 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7772 eturn6=eturn6+eello_turn6(i,jj,kk)
7773 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7774 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7775 cd write (2,*) 'multibody_eello:eturn6',eturn6
7784 num_cont_hb(i)=num_cont_hb_old(i)
7786 c write (iout,*) "gradcorr5 in eello5"
7788 c write (iout,'(i5,3f10.5)')
7789 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7793 c------------------------------------------------------------------------------
7794 subroutine add_hb_contact_eello(ii,jj,itask)
7795 implicit real*8 (a-h,o-z)
7796 include "DIMENSIONS"
7797 include "COMMON.IOUNITS"
7800 parameter (max_cont=maxconts)
7801 parameter (max_dim=70)
7802 include "COMMON.CONTACTS"
7803 double precision zapas(max_dim,maxconts,max_fg_procs),
7804 & zapas_recv(max_dim,maxconts,max_fg_procs)
7805 common /przechowalnia/ zapas
7806 integer i,j,ii,jj,iproc,itask(4),nn
7807 c write (iout,*) "itask",itask
7810 if (iproc.gt.0) then
7811 do j=1,num_cont_hb(ii)
7813 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7815 ncont_sent(iproc)=ncont_sent(iproc)+1
7816 nn=ncont_sent(iproc)
7817 zapas(1,nn,iproc)=ii
7818 zapas(2,nn,iproc)=jjc
7819 zapas(3,nn,iproc)=d_cont(j,ii)
7823 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7828 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7836 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7848 c------------------------------------------------------------------------------
7849 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7850 implicit real*8 (a-h,o-z)
7851 include 'DIMENSIONS'
7852 include 'COMMON.IOUNITS'
7853 include 'COMMON.DERIV'
7854 include 'COMMON.INTERACT'
7855 include 'COMMON.CONTACTS'
7856 double precision gx(3),gx1(3)
7866 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7867 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7868 C Following 4 lines for diagnostics.
7873 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7874 c & 'Contacts ',i,j,
7875 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7876 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7878 C Calculate the multi-body contribution to energy.
7879 c ecorr=ecorr+ekont*ees
7880 C Calculate multi-body contributions to the gradient.
7881 coeffpees0pij=coeffp*ees0pij
7882 coeffmees0mij=coeffm*ees0mij
7883 coeffpees0pkl=coeffp*ees0pkl
7884 coeffmees0mkl=coeffm*ees0mkl
7886 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7887 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7888 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7889 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7890 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7891 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7892 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7893 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7894 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7895 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7896 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7897 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7898 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7899 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7900 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7901 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7902 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7903 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7904 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7905 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7906 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7907 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7908 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7909 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7910 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7915 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7916 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7917 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7918 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7923 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7924 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7925 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7926 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7929 c write (iout,*) "ehbcorr",ekont*ees
7934 C---------------------------------------------------------------------------
7935 subroutine dipole(i,j,jj)
7936 implicit real*8 (a-h,o-z)
7937 include 'DIMENSIONS'
7938 include 'COMMON.IOUNITS'
7939 include 'COMMON.CHAIN'
7940 include 'COMMON.FFIELD'
7941 include 'COMMON.DERIV'
7942 include 'COMMON.INTERACT'
7943 include 'COMMON.CONTACTS'
7944 include 'COMMON.TORSION'
7945 include 'COMMON.VAR'
7946 include 'COMMON.GEO'
7947 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7949 iti1 = itortyp(itype(i+1))
7950 if (j.lt.nres-1) then
7951 itj1 = itortyp(itype(j+1))
7956 dipi(iii,1)=Ub2(iii,i)
7957 dipderi(iii)=Ub2der(iii,i)
7958 dipi(iii,2)=b1(iii,i+1)
7959 dipj(iii,1)=Ub2(iii,j)
7960 dipderj(iii)=Ub2der(iii,j)
7961 dipj(iii,2)=b1(iii,j+1)
7965 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7968 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7975 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7979 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7984 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7985 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7987 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7989 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7991 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7996 C---------------------------------------------------------------------------
7997 subroutine calc_eello(i,j,k,l,jj,kk)
7999 C This subroutine computes matrices and vectors needed to calculate
8000 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
8002 implicit real*8 (a-h,o-z)
8003 include 'DIMENSIONS'
8004 include 'COMMON.IOUNITS'
8005 include 'COMMON.CHAIN'
8006 include 'COMMON.DERIV'
8007 include 'COMMON.INTERACT'
8008 include 'COMMON.CONTACTS'
8009 include 'COMMON.TORSION'
8010 include 'COMMON.VAR'
8011 include 'COMMON.GEO'
8012 include 'COMMON.FFIELD'
8013 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8014 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8017 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8018 cd & ' jj=',jj,' kk=',kk
8019 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8020 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8021 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8024 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8025 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8028 call transpose2(aa1(1,1),aa1t(1,1))
8029 call transpose2(aa2(1,1),aa2t(1,1))
8032 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8033 & aa1tder(1,1,lll,kkk))
8034 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8035 & aa2tder(1,1,lll,kkk))
8039 C parallel orientation of the two CA-CA-CA frames.
8041 iti=itortyp(itype(i))
8045 itk1=itortyp(itype(k+1))
8046 itj=itortyp(itype(j))
8047 if (l.lt.nres-1) then
8048 itl1=itortyp(itype(l+1))
8052 C A1 kernel(j+1) A2T
8054 cd write (iout,'(3f10.5,5x,3f10.5)')
8055 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8057 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8058 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8059 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8060 C Following matrices are needed only for 6-th order cumulants
8061 IF (wcorr6.gt.0.0d0) THEN
8062 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8063 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8064 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8065 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8066 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8067 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8068 & ADtEAderx(1,1,1,1,1,1))
8070 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8071 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8072 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8073 & ADtEA1derx(1,1,1,1,1,1))
8075 C End 6-th order cumulants
8078 cd write (2,*) 'In calc_eello6'
8080 cd write (2,*) 'iii=',iii
8082 cd write (2,*) 'kkk=',kkk
8084 cd write (2,'(3(2f10.5),5x)')
8085 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8090 call transpose2(EUgder(1,1,k),auxmat(1,1))
8091 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8092 call transpose2(EUg(1,1,k),auxmat(1,1))
8093 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8094 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8098 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8099 & EAEAderx(1,1,lll,kkk,iii,1))
8103 C A1T kernel(i+1) A2
8104 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8105 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8106 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8107 C Following matrices are needed only for 6-th order cumulants
8108 IF (wcorr6.gt.0.0d0) THEN
8109 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8110 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
8111 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8112 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8113 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
8114 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8115 & ADtEAderx(1,1,1,1,1,2))
8116 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8117 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
8118 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8119 & ADtEA1derx(1,1,1,1,1,2))
8121 C End 6-th order cumulants
8122 call transpose2(EUgder(1,1,l),auxmat(1,1))
8123 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8124 call transpose2(EUg(1,1,l),auxmat(1,1))
8125 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8126 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8130 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8131 & EAEAderx(1,1,lll,kkk,iii,2))
8136 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8137 C They are needed only when the fifth- or the sixth-order cumulants are
8139 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8140 call transpose2(AEA(1,1,1),auxmat(1,1))
8141 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8142 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8143 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8144 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8145 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8146 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8147 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8148 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8149 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8150 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8151 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8152 call transpose2(AEA(1,1,2),auxmat(1,1))
8153 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
8154 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8155 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8156 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8157 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
8158 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8159 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
8160 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
8161 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8162 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8163 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8164 C Calculate the Cartesian derivatives of the vectors.
8168 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8169 call matvec2(auxmat(1,1),b1(1,i),
8170 & AEAb1derx(1,lll,kkk,iii,1,1))
8171 call matvec2(auxmat(1,1),Ub2(1,i),
8172 & AEAb2derx(1,lll,kkk,iii,1,1))
8173 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8174 & AEAb1derx(1,lll,kkk,iii,2,1))
8175 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8176 & AEAb2derx(1,lll,kkk,iii,2,1))
8177 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8178 call matvec2(auxmat(1,1),b1(1,j),
8179 & AEAb1derx(1,lll,kkk,iii,1,2))
8180 call matvec2(auxmat(1,1),Ub2(1,j),
8181 & AEAb2derx(1,lll,kkk,iii,1,2))
8182 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8183 & AEAb1derx(1,lll,kkk,iii,2,2))
8184 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
8185 & AEAb2derx(1,lll,kkk,iii,2,2))
8192 C Antiparallel orientation of the two CA-CA-CA frames.
8194 iti=itortyp(itype(i))
8198 itk1=itortyp(itype(k+1))
8199 itl=itortyp(itype(l))
8200 itj=itortyp(itype(j))
8201 if (j.lt.nres-1) then
8202 itj1=itortyp(itype(j+1))
8206 C A2 kernel(j-1)T A1T
8207 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8208 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
8209 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8210 C Following matrices are needed only for 6-th order cumulants
8211 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8212 & j.eq.i+4 .and. l.eq.i+3)) THEN
8213 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8214 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
8215 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8216 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8217 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8218 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8219 & ADtEAderx(1,1,1,1,1,1))
8220 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8221 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8222 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8223 & ADtEA1derx(1,1,1,1,1,1))
8225 C End 6-th order cumulants
8226 call transpose2(EUgder(1,1,k),auxmat(1,1))
8227 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8228 call transpose2(EUg(1,1,k),auxmat(1,1))
8229 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8230 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8234 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8235 & EAEAderx(1,1,lll,kkk,iii,1))
8239 C A2T kernel(i+1)T A1
8240 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8241 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
8242 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8243 C Following matrices are needed only for 6-th order cumulants
8244 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8245 & j.eq.i+4 .and. l.eq.i+3)) THEN
8246 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8247 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8248 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8249 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8250 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8251 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8252 & ADtEAderx(1,1,1,1,1,2))
8253 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8254 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8255 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8256 & ADtEA1derx(1,1,1,1,1,2))
8258 C End 6-th order cumulants
8259 call transpose2(EUgder(1,1,j),auxmat(1,1))
8260 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8261 call transpose2(EUg(1,1,j),auxmat(1,1))
8262 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8263 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8267 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8268 & EAEAderx(1,1,lll,kkk,iii,2))
8273 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8274 C They are needed only when the fifth- or the sixth-order cumulants are
8276 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8277 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8278 call transpose2(AEA(1,1,1),auxmat(1,1))
8279 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8280 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8281 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8282 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8283 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8284 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8285 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8286 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8287 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8288 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8289 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8290 call transpose2(AEA(1,1,2),auxmat(1,1))
8291 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
8292 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8293 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8294 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8295 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
8296 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8297 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
8298 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
8299 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8300 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8301 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8302 C Calculate the Cartesian derivatives of the vectors.
8306 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8307 call matvec2(auxmat(1,1),b1(1,i),
8308 & AEAb1derx(1,lll,kkk,iii,1,1))
8309 call matvec2(auxmat(1,1),Ub2(1,i),
8310 & AEAb2derx(1,lll,kkk,iii,1,1))
8311 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8312 & AEAb1derx(1,lll,kkk,iii,2,1))
8313 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8314 & AEAb2derx(1,lll,kkk,iii,2,1))
8315 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8316 call matvec2(auxmat(1,1),b1(1,l),
8317 & AEAb1derx(1,lll,kkk,iii,1,2))
8318 call matvec2(auxmat(1,1),Ub2(1,l),
8319 & AEAb2derx(1,lll,kkk,iii,1,2))
8320 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
8321 & AEAb1derx(1,lll,kkk,iii,2,2))
8322 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8323 & AEAb2derx(1,lll,kkk,iii,2,2))
8332 C---------------------------------------------------------------------------
8333 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8334 & KK,KKderg,AKA,AKAderg,AKAderx)
8338 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8339 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8340 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8345 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8347 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8350 cd if (lprn) write (2,*) 'In kernel'
8352 cd if (lprn) write (2,*) 'kkk=',kkk
8354 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8355 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8357 cd write (2,*) 'lll=',lll
8358 cd write (2,*) 'iii=1'
8360 cd write (2,'(3(2f10.5),5x)')
8361 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8364 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8365 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8367 cd write (2,*) 'lll=',lll
8368 cd write (2,*) 'iii=2'
8370 cd write (2,'(3(2f10.5),5x)')
8371 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8378 C---------------------------------------------------------------------------
8379 double precision function eello4(i,j,k,l,jj,kk)
8380 implicit real*8 (a-h,o-z)
8381 include 'DIMENSIONS'
8382 include 'COMMON.IOUNITS'
8383 include 'COMMON.CHAIN'
8384 include 'COMMON.DERIV'
8385 include 'COMMON.INTERACT'
8386 include 'COMMON.CONTACTS'
8387 include 'COMMON.TORSION'
8388 include 'COMMON.VAR'
8389 include 'COMMON.GEO'
8390 double precision pizda(2,2),ggg1(3),ggg2(3)
8391 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8395 cd print *,'eello4:',i,j,k,l,jj,kk
8396 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8397 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8398 cold eij=facont_hb(jj,i)
8399 cold ekl=facont_hb(kk,k)
8401 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8402 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8403 gcorr_loc(k-1)=gcorr_loc(k-1)
8404 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8406 gcorr_loc(l-1)=gcorr_loc(l-1)
8407 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8409 gcorr_loc(j-1)=gcorr_loc(j-1)
8410 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8415 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8416 & -EAEAderx(2,2,lll,kkk,iii,1)
8417 cd derx(lll,kkk,iii)=0.0d0
8421 cd gcorr_loc(l-1)=0.0d0
8422 cd gcorr_loc(j-1)=0.0d0
8423 cd gcorr_loc(k-1)=0.0d0
8425 cd write (iout,*)'Contacts have occurred for peptide groups',
8426 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8427 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8428 if (j.lt.nres-1) then
8435 if (l.lt.nres-1) then
8443 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8444 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8445 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8446 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8447 cgrad ghalf=0.5d0*ggg1(ll)
8448 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8449 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8450 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8451 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8452 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8453 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8454 cgrad ghalf=0.5d0*ggg2(ll)
8455 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8456 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8457 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8458 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8459 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8460 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8464 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8469 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8474 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8479 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8483 cd write (2,*) iii,gcorr_loc(iii)
8486 cd write (2,*) 'ekont',ekont
8487 cd write (iout,*) 'eello4',ekont*eel4
8490 C---------------------------------------------------------------------------
8491 double precision function eello5(i,j,k,l,jj,kk)
8492 implicit real*8 (a-h,o-z)
8493 include 'DIMENSIONS'
8494 include 'COMMON.IOUNITS'
8495 include 'COMMON.CHAIN'
8496 include 'COMMON.DERIV'
8497 include 'COMMON.INTERACT'
8498 include 'COMMON.CONTACTS'
8499 include 'COMMON.TORSION'
8500 include 'COMMON.VAR'
8501 include 'COMMON.GEO'
8502 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8503 double precision ggg1(3),ggg2(3)
8504 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8509 C /l\ / \ \ / \ / \ / C
8510 C / \ / \ \ / \ / \ / C
8511 C j| o |l1 | o | o| o | | o |o C
8512 C \ |/k\| |/ \| / |/ \| |/ \| C
8513 C \i/ \ / \ / / \ / \ C
8515 C (I) (II) (III) (IV) C
8517 C eello5_1 eello5_2 eello5_3 eello5_4 C
8519 C Antiparallel chains C
8522 C /j\ / \ \ / \ / \ / C
8523 C / \ / \ \ / \ / \ / C
8524 C j1| o |l | o | o| o | | o |o C
8525 C \ |/k\| |/ \| / |/ \| |/ \| C
8526 C \i/ \ / \ / / \ / \ C
8528 C (I) (II) (III) (IV) C
8530 C eello5_1 eello5_2 eello5_3 eello5_4 C
8532 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8534 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8535 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8540 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8542 itk=itortyp(itype(k))
8543 itl=itortyp(itype(l))
8544 itj=itortyp(itype(j))
8549 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8550 cd & eel5_3_num,eel5_4_num)
8554 derx(lll,kkk,iii)=0.0d0
8558 cd eij=facont_hb(jj,i)
8559 cd ekl=facont_hb(kk,k)
8561 cd write (iout,*)'Contacts have occurred for peptide groups',
8562 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8564 C Contribution from the graph I.
8565 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8566 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8567 call transpose2(EUg(1,1,k),auxmat(1,1))
8568 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8569 vv(1)=pizda(1,1)-pizda(2,2)
8570 vv(2)=pizda(1,2)+pizda(2,1)
8571 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8572 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8573 C Explicit gradient in virtual-dihedral angles.
8574 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8575 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8576 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8577 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8578 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8579 vv(1)=pizda(1,1)-pizda(2,2)
8580 vv(2)=pizda(1,2)+pizda(2,1)
8581 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8582 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8583 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8584 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8585 vv(1)=pizda(1,1)-pizda(2,2)
8586 vv(2)=pizda(1,2)+pizda(2,1)
8588 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8589 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8590 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8592 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8593 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8594 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8596 C Cartesian gradient
8600 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8602 vv(1)=pizda(1,1)-pizda(2,2)
8603 vv(2)=pizda(1,2)+pizda(2,1)
8604 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8605 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8606 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8612 C Contribution from graph II
8613 call transpose2(EE(1,1,itk),auxmat(1,1))
8614 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8615 vv(1)=pizda(1,1)+pizda(2,2)
8616 vv(2)=pizda(2,1)-pizda(1,2)
8617 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8618 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8619 C Explicit gradient in virtual-dihedral angles.
8620 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8621 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8622 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8623 vv(1)=pizda(1,1)+pizda(2,2)
8624 vv(2)=pizda(2,1)-pizda(1,2)
8626 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8627 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8628 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8630 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8631 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8632 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8634 C Cartesian gradient
8638 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8640 vv(1)=pizda(1,1)+pizda(2,2)
8641 vv(2)=pizda(2,1)-pizda(1,2)
8642 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8643 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8644 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8652 C Parallel orientation
8653 C Contribution from graph III
8654 call transpose2(EUg(1,1,l),auxmat(1,1))
8655 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8656 vv(1)=pizda(1,1)-pizda(2,2)
8657 vv(2)=pizda(1,2)+pizda(2,1)
8658 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8659 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8660 C Explicit gradient in virtual-dihedral angles.
8661 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8662 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8663 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8664 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8665 vv(1)=pizda(1,1)-pizda(2,2)
8666 vv(2)=pizda(1,2)+pizda(2,1)
8667 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8668 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8669 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8670 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8671 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8672 vv(1)=pizda(1,1)-pizda(2,2)
8673 vv(2)=pizda(1,2)+pizda(2,1)
8674 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8675 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8676 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8677 C Cartesian gradient
8681 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8683 vv(1)=pizda(1,1)-pizda(2,2)
8684 vv(2)=pizda(1,2)+pizda(2,1)
8685 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8686 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8687 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8692 C Contribution from graph IV
8694 call transpose2(EE(1,1,itl),auxmat(1,1))
8695 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8696 vv(1)=pizda(1,1)+pizda(2,2)
8697 vv(2)=pizda(2,1)-pizda(1,2)
8698 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8699 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8700 C Explicit gradient in virtual-dihedral angles.
8701 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8702 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8703 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8704 vv(1)=pizda(1,1)+pizda(2,2)
8705 vv(2)=pizda(2,1)-pizda(1,2)
8706 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8707 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8708 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8709 C Cartesian gradient
8713 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8715 vv(1)=pizda(1,1)+pizda(2,2)
8716 vv(2)=pizda(2,1)-pizda(1,2)
8717 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8718 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
8719 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8724 C Antiparallel orientation
8725 C Contribution from graph III
8727 call transpose2(EUg(1,1,j),auxmat(1,1))
8728 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8729 vv(1)=pizda(1,1)-pizda(2,2)
8730 vv(2)=pizda(1,2)+pizda(2,1)
8731 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8732 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8733 C Explicit gradient in virtual-dihedral angles.
8734 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8735 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8736 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8737 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8738 vv(1)=pizda(1,1)-pizda(2,2)
8739 vv(2)=pizda(1,2)+pizda(2,1)
8740 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8741 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8742 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8743 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8744 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8745 vv(1)=pizda(1,1)-pizda(2,2)
8746 vv(2)=pizda(1,2)+pizda(2,1)
8747 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8748 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8749 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8750 C Cartesian gradient
8754 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8756 vv(1)=pizda(1,1)-pizda(2,2)
8757 vv(2)=pizda(1,2)+pizda(2,1)
8758 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8759 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8760 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8765 C Contribution from graph IV
8767 call transpose2(EE(1,1,itj),auxmat(1,1))
8768 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8769 vv(1)=pizda(1,1)+pizda(2,2)
8770 vv(2)=pizda(2,1)-pizda(1,2)
8771 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
8772 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8773 C Explicit gradient in virtual-dihedral angles.
8774 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8775 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8776 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8777 vv(1)=pizda(1,1)+pizda(2,2)
8778 vv(2)=pizda(2,1)-pizda(1,2)
8779 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8780 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
8781 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8782 C Cartesian gradient
8786 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8788 vv(1)=pizda(1,1)+pizda(2,2)
8789 vv(2)=pizda(2,1)-pizda(1,2)
8790 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8791 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
8792 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8798 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8799 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8800 cd write (2,*) 'ijkl',i,j,k,l
8801 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8802 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8804 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8805 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8806 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8807 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8808 if (j.lt.nres-1) then
8815 if (l.lt.nres-1) then
8825 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8826 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8827 C summed up outside the subrouine as for the other subroutines
8828 C handling long-range interactions. The old code is commented out
8829 C with "cgrad" to keep track of changes.
8831 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8832 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8833 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8834 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8835 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8836 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8837 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8838 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8839 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8840 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8842 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8843 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8844 cgrad ghalf=0.5d0*ggg1(ll)
8846 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8847 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8848 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8849 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8850 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8851 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8852 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8853 cgrad ghalf=0.5d0*ggg2(ll)
8855 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8856 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8857 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8858 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8859 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8860 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8865 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8866 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8871 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8872 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8878 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8883 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8887 cd write (2,*) iii,g_corr5_loc(iii)
8890 cd write (2,*) 'ekont',ekont
8891 cd write (iout,*) 'eello5',ekont*eel5
8894 c--------------------------------------------------------------------------
8895 double precision function eello6(i,j,k,l,jj,kk)
8896 implicit real*8 (a-h,o-z)
8897 include 'DIMENSIONS'
8898 include 'COMMON.IOUNITS'
8899 include 'COMMON.CHAIN'
8900 include 'COMMON.DERIV'
8901 include 'COMMON.INTERACT'
8902 include 'COMMON.CONTACTS'
8903 include 'COMMON.TORSION'
8904 include 'COMMON.VAR'
8905 include 'COMMON.GEO'
8906 include 'COMMON.FFIELD'
8907 double precision ggg1(3),ggg2(3)
8908 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8913 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8921 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8922 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8926 derx(lll,kkk,iii)=0.0d0
8930 cd eij=facont_hb(jj,i)
8931 cd ekl=facont_hb(kk,k)
8937 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8938 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8939 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8940 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8941 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8942 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8944 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8945 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8946 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8947 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8948 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8949 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8953 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8955 C If turn contributions are considered, they will be handled separately.
8956 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8957 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8958 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8959 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8960 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8961 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8962 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8964 if (j.lt.nres-1) then
8971 if (l.lt.nres-1) then
8979 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8980 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8981 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8982 cgrad ghalf=0.5d0*ggg1(ll)
8984 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8985 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8986 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8987 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8988 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8989 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8990 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8991 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8992 cgrad ghalf=0.5d0*ggg2(ll)
8993 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8995 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8996 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8997 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8998 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8999 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9000 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9005 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9006 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9011 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9012 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9018 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9023 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9027 cd write (2,*) iii,g_corr6_loc(iii)
9030 cd write (2,*) 'ekont',ekont
9031 cd write (iout,*) 'eello6',ekont*eel6
9034 c--------------------------------------------------------------------------
9035 double precision function eello6_graph1(i,j,k,l,imat,swap)
9036 implicit real*8 (a-h,o-z)
9037 include 'DIMENSIONS'
9038 include 'COMMON.IOUNITS'
9039 include 'COMMON.CHAIN'
9040 include 'COMMON.DERIV'
9041 include 'COMMON.INTERACT'
9042 include 'COMMON.CONTACTS'
9043 include 'COMMON.TORSION'
9044 include 'COMMON.VAR'
9045 include 'COMMON.GEO'
9046 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9050 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9052 C Parallel Antiparallel C
9058 C \ j|/k\| / \ |/k\|l / C
9063 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9064 itk=itortyp(itype(k))
9065 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9066 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9067 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9068 call transpose2(EUgC(1,1,k),auxmat(1,1))
9069 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9070 vv1(1)=pizda1(1,1)-pizda1(2,2)
9071 vv1(2)=pizda1(1,2)+pizda1(2,1)
9072 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9073 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
9074 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
9075 s5=scalar2(vv(1),Dtobr2(1,i))
9076 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9077 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9078 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9079 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9080 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9081 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9082 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9083 & +scalar2(vv(1),Dtobr2der(1,i)))
9084 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9085 vv1(1)=pizda1(1,1)-pizda1(2,2)
9086 vv1(2)=pizda1(1,2)+pizda1(2,1)
9087 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
9088 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
9090 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9091 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9092 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9093 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9094 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9096 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9097 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9098 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9099 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9100 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9102 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9103 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9104 vv1(1)=pizda1(1,1)-pizda1(2,2)
9105 vv1(2)=pizda1(1,2)+pizda1(2,1)
9106 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9107 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9108 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
9109 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9118 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9119 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9120 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9121 call transpose2(EUgC(1,1,k),auxmat(1,1))
9122 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9124 vv1(1)=pizda1(1,1)-pizda1(2,2)
9125 vv1(2)=pizda1(1,2)+pizda1(2,1)
9126 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9127 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
9128 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
9129 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
9130 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
9131 s5=scalar2(vv(1),Dtobr2(1,i))
9132 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9138 c----------------------------------------------------------------------------
9139 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
9140 implicit real*8 (a-h,o-z)
9141 include 'DIMENSIONS'
9142 include 'COMMON.IOUNITS'
9143 include 'COMMON.CHAIN'
9144 include 'COMMON.DERIV'
9145 include 'COMMON.INTERACT'
9146 include 'COMMON.CONTACTS'
9147 include 'COMMON.TORSION'
9148 include 'COMMON.VAR'
9149 include 'COMMON.GEO'
9151 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9152 & auxvec1(2),auxvec2(2),auxmat1(2,2)
9155 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9157 C Parallel Antiparallel C
9163 C \ j|/k\| \ |/k\|l C
9168 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9169 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9170 C AL 7/4/01 s1 would occur in the sixth-order moment,
9171 C but not in a cluster cumulant
9173 s1=dip(1,jj,i)*dip(1,kk,k)
9175 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9176 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9177 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9178 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9179 call transpose2(EUg(1,1,k),auxmat(1,1))
9180 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9181 vv(1)=pizda(1,1)-pizda(2,2)
9182 vv(2)=pizda(1,2)+pizda(2,1)
9183 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9184 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9186 eello6_graph2=-(s1+s2+s3+s4)
9188 eello6_graph2=-(s2+s3+s4)
9191 C Derivatives in gamma(i-1)
9194 s1=dipderg(1,jj,i)*dip(1,kk,k)
9196 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9197 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9198 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9199 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9201 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9203 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9205 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9207 C Derivatives in gamma(k-1)
9209 s1=dip(1,jj,i)*dipderg(1,kk,k)
9211 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9212 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9213 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9214 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9215 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9216 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9217 vv(1)=pizda(1,1)-pizda(2,2)
9218 vv(2)=pizda(1,2)+pizda(2,1)
9219 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9221 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9223 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9225 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9226 C Derivatives in gamma(j-1) or gamma(l-1)
9229 s1=dipderg(3,jj,i)*dip(1,kk,k)
9231 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9232 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9233 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9234 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9235 vv(1)=pizda(1,1)-pizda(2,2)
9236 vv(2)=pizda(1,2)+pizda(2,1)
9237 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9240 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9242 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9245 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9246 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9248 C Derivatives in gamma(l-1) or gamma(j-1)
9251 s1=dip(1,jj,i)*dipderg(3,kk,k)
9253 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9254 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9255 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9256 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9257 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9258 vv(1)=pizda(1,1)-pizda(2,2)
9259 vv(2)=pizda(1,2)+pizda(2,1)
9260 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9263 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9265 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9268 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9269 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9271 C Cartesian derivatives.
9273 write (2,*) 'In eello6_graph2'
9275 write (2,*) 'iii=',iii
9277 write (2,*) 'kkk=',kkk
9279 write (2,'(3(2f10.5),5x)')
9280 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9290 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9292 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9295 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9297 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9298 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9300 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9301 call transpose2(EUg(1,1,k),auxmat(1,1))
9302 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9304 vv(1)=pizda(1,1)-pizda(2,2)
9305 vv(2)=pizda(1,2)+pizda(2,1)
9306 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9307 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9309 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9311 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9314 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9316 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9323 c----------------------------------------------------------------------------
9324 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9325 implicit real*8 (a-h,o-z)
9326 include 'DIMENSIONS'
9327 include 'COMMON.IOUNITS'
9328 include 'COMMON.CHAIN'
9329 include 'COMMON.DERIV'
9330 include 'COMMON.INTERACT'
9331 include 'COMMON.CONTACTS'
9332 include 'COMMON.TORSION'
9333 include 'COMMON.VAR'
9334 include 'COMMON.GEO'
9335 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9337 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9339 C Parallel Antiparallel C
9345 C j|/k\| / |/k\|l / C
9350 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9352 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9353 C energy moment and not to the cluster cumulant.
9354 iti=itortyp(itype(i))
9355 if (j.lt.nres-1) then
9356 itj1=itortyp(itype(j+1))
9360 itk=itortyp(itype(k))
9361 itk1=itortyp(itype(k+1))
9362 if (l.lt.nres-1) then
9363 itl1=itortyp(itype(l+1))
9368 s1=dip(4,jj,i)*dip(4,kk,k)
9370 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
9371 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9372 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
9373 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9374 call transpose2(EE(1,1,itk),auxmat(1,1))
9375 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9376 vv(1)=pizda(1,1)+pizda(2,2)
9377 vv(2)=pizda(2,1)-pizda(1,2)
9378 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9379 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9380 cd & "sum",-(s2+s3+s4)
9382 eello6_graph3=-(s1+s2+s3+s4)
9384 eello6_graph3=-(s2+s3+s4)
9387 C Derivatives in gamma(k-1)
9388 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
9389 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9390 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9391 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9392 C Derivatives in gamma(l-1)
9393 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
9394 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9395 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9396 vv(1)=pizda(1,1)+pizda(2,2)
9397 vv(2)=pizda(2,1)-pizda(1,2)
9398 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9399 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9400 C Cartesian derivatives.
9406 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9408 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9411 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9413 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9414 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9416 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9417 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9419 vv(1)=pizda(1,1)+pizda(2,2)
9420 vv(2)=pizda(2,1)-pizda(1,2)
9421 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9423 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9425 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9428 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9430 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9432 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9438 c----------------------------------------------------------------------------
9439 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9440 implicit real*8 (a-h,o-z)
9441 include 'DIMENSIONS'
9442 include 'COMMON.IOUNITS'
9443 include 'COMMON.CHAIN'
9444 include 'COMMON.DERIV'
9445 include 'COMMON.INTERACT'
9446 include 'COMMON.CONTACTS'
9447 include 'COMMON.TORSION'
9448 include 'COMMON.VAR'
9449 include 'COMMON.GEO'
9450 include 'COMMON.FFIELD'
9451 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9452 & auxvec1(2),auxmat1(2,2)
9454 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9456 C Parallel Antiparallel C
9462 C \ j|/k\| \ |/k\|l C
9467 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9469 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9470 C energy moment and not to the cluster cumulant.
9471 cd write (2,*) 'eello_graph4: wturn6',wturn6
9472 iti=itortyp(itype(i))
9473 itj=itortyp(itype(j))
9474 if (j.lt.nres-1) then
9475 itj1=itortyp(itype(j+1))
9479 itk=itortyp(itype(k))
9480 if (k.lt.nres-1) then
9481 itk1=itortyp(itype(k+1))
9485 itl=itortyp(itype(l))
9486 if (l.lt.nres-1) then
9487 itl1=itortyp(itype(l+1))
9491 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9492 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9493 cd & ' itl',itl,' itl1',itl1
9496 s1=dip(3,jj,i)*dip(3,kk,k)
9498 s1=dip(2,jj,j)*dip(2,kk,l)
9501 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9502 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9504 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9505 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9507 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9508 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9510 call transpose2(EUg(1,1,k),auxmat(1,1))
9511 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9512 vv(1)=pizda(1,1)-pizda(2,2)
9513 vv(2)=pizda(2,1)+pizda(1,2)
9514 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9515 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9517 eello6_graph4=-(s1+s2+s3+s4)
9519 eello6_graph4=-(s2+s3+s4)
9521 C Derivatives in gamma(i-1)
9525 s1=dipderg(2,jj,i)*dip(3,kk,k)
9527 s1=dipderg(4,jj,j)*dip(2,kk,l)
9530 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9532 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9533 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9535 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9536 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9538 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9539 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9540 cd write (2,*) 'turn6 derivatives'
9542 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9544 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9548 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9550 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9554 C Derivatives in gamma(k-1)
9557 s1=dip(3,jj,i)*dipderg(2,kk,k)
9559 s1=dip(2,jj,j)*dipderg(4,kk,l)
9562 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9563 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9565 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9566 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9568 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9569 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9571 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9572 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9573 vv(1)=pizda(1,1)-pizda(2,2)
9574 vv(2)=pizda(2,1)+pizda(1,2)
9575 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9576 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9578 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9580 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9584 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9586 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9589 C Derivatives in gamma(j-1) or gamma(l-1)
9590 if (l.eq.j+1 .and. l.gt.1) then
9591 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9592 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9593 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9594 vv(1)=pizda(1,1)-pizda(2,2)
9595 vv(2)=pizda(2,1)+pizda(1,2)
9596 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9597 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9598 else if (j.gt.1) then
9599 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9600 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9601 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9602 vv(1)=pizda(1,1)-pizda(2,2)
9603 vv(2)=pizda(2,1)+pizda(1,2)
9604 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9605 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9606 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9608 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9611 C Cartesian derivatives.
9618 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9620 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9624 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9626 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9630 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9632 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9634 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9635 & b1(1,j+1),auxvec(1))
9636 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9638 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9639 & b1(1,l+1),auxvec(1))
9640 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9642 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9644 vv(1)=pizda(1,1)-pizda(2,2)
9645 vv(2)=pizda(2,1)+pizda(1,2)
9646 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9648 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9650 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9653 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9656 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9659 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9661 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9663 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9667 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9669 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9672 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9674 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9682 c----------------------------------------------------------------------------
9683 double precision function eello_turn6(i,jj,kk)
9684 implicit real*8 (a-h,o-z)
9685 include 'DIMENSIONS'
9686 include 'COMMON.IOUNITS'
9687 include 'COMMON.CHAIN'
9688 include 'COMMON.DERIV'
9689 include 'COMMON.INTERACT'
9690 include 'COMMON.CONTACTS'
9691 include 'COMMON.TORSION'
9692 include 'COMMON.VAR'
9693 include 'COMMON.GEO'
9694 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9695 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9697 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9698 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9699 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9700 C the respective energy moment and not to the cluster cumulant.
9709 iti=itortyp(itype(i))
9710 itk=itortyp(itype(k))
9711 itk1=itortyp(itype(k+1))
9712 itl=itortyp(itype(l))
9713 itj=itortyp(itype(j))
9714 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9715 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9716 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9721 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9723 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9727 derx_turn(lll,kkk,iii)=0.0d0
9734 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9736 cd write (2,*) 'eello6_5',eello6_5
9738 call transpose2(AEA(1,1,1),auxmat(1,1))
9739 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9740 ss1=scalar2(Ub2(1,i+2),b1(1,l))
9741 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9743 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9744 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9745 s2 = scalar2(b1(1,k),vtemp1(1))
9747 call transpose2(AEA(1,1,2),atemp(1,1))
9748 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9749 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9750 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9752 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9753 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9754 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9756 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9757 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9758 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9759 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9760 ss13 = scalar2(b1(1,k),vtemp4(1))
9761 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9763 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9769 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9770 C Derivatives in gamma(i+2)
9774 call transpose2(AEA(1,1,1),auxmatd(1,1))
9775 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9776 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9777 call transpose2(AEAderg(1,1,2),atempd(1,1))
9778 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9779 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9781 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9782 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9783 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9789 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9790 C Derivatives in gamma(i+3)
9792 call transpose2(AEA(1,1,1),auxmatd(1,1))
9793 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9794 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
9795 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9797 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
9798 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9799 s2d = scalar2(b1(1,k),vtemp1d(1))
9801 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9802 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9804 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9806 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9807 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9808 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9816 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9817 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9819 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9820 & -0.5d0*ekont*(s2d+s12d)
9822 C Derivatives in gamma(i+4)
9823 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9824 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9825 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9827 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9828 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9829 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9837 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9839 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9841 C Derivatives in gamma(i+5)
9843 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9844 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9845 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9847 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
9848 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9849 s2d = scalar2(b1(1,k),vtemp1d(1))
9851 call transpose2(AEA(1,1,2),atempd(1,1))
9852 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9853 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9855 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9856 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9858 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9859 ss13d = scalar2(b1(1,k),vtemp4d(1))
9860 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9868 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9869 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9871 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9872 & -0.5d0*ekont*(s2d+s12d)
9874 C Cartesian derivatives
9879 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9880 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9881 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9883 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9884 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9886 s2d = scalar2(b1(1,k),vtemp1d(1))
9888 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9889 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9890 s8d = -(atempd(1,1)+atempd(2,2))*
9891 & scalar2(cc(1,1,itl),vtemp2(1))
9893 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9895 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9896 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9903 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9906 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9910 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9911 & - 0.5d0*(s8d+s12d)
9913 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9922 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9924 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9925 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9926 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9927 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9928 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9930 ss13d = scalar2(b1(1,k),vtemp4d(1))
9931 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9932 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9936 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9937 cd & 16*eel_turn6_num
9939 if (j.lt.nres-1) then
9946 if (l.lt.nres-1) then
9954 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9955 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9956 cgrad ghalf=0.5d0*ggg1(ll)
9958 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9959 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9960 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9961 & +ekont*derx_turn(ll,2,1)
9962 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9963 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9964 & +ekont*derx_turn(ll,4,1)
9965 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9966 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9967 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9968 cgrad ghalf=0.5d0*ggg2(ll)
9970 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9971 & +ekont*derx_turn(ll,2,2)
9972 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9973 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9974 & +ekont*derx_turn(ll,4,2)
9975 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9976 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9977 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9982 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9987 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9993 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9998 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10002 cd write (2,*) iii,g_corr6_loc(iii)
10004 eello_turn6=ekont*eel_turn6
10005 cd write (2,*) 'ekont',ekont
10006 cd write (2,*) 'eel_turn6',ekont*eel_turn6
10010 C-----------------------------------------------------------------------------
10011 double precision function scalar(u,v)
10012 !DIR$ INLINEALWAYS scalar
10014 cDEC$ ATTRIBUTES FORCEINLINE::scalar
10017 double precision u(3),v(3)
10018 cd double precision sc
10026 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
10029 crc-------------------------------------------------
10030 SUBROUTINE MATVEC2(A1,V1,V2)
10031 !DIR$ INLINEALWAYS MATVEC2
10033 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10035 implicit real*8 (a-h,o-z)
10036 include 'DIMENSIONS'
10037 DIMENSION A1(2,2),V1(2),V2(2)
10041 c 3 VI=VI+A1(I,K)*V1(K)
10045 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10046 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10051 C---------------------------------------
10052 SUBROUTINE MATMAT2(A1,A2,A3)
10054 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10056 implicit real*8 (a-h,o-z)
10057 include 'DIMENSIONS'
10058 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10059 c DIMENSION AI3(2,2)
10063 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10069 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10070 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10071 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10072 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10080 c-------------------------------------------------------------------------
10081 double precision function scalar2(u,v)
10082 !DIR$ INLINEALWAYS scalar2
10084 double precision u(2),v(2)
10085 double precision sc
10087 scalar2=u(1)*v(1)+u(2)*v(2)
10091 C-----------------------------------------------------------------------------
10093 subroutine transpose2(a,at)
10094 !DIR$ INLINEALWAYS transpose2
10096 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
10099 double precision a(2,2),at(2,2)
10106 c--------------------------------------------------------------------------
10107 subroutine transpose(n,a,at)
10110 double precision a(n,n),at(n,n)
10118 C---------------------------------------------------------------------------
10119 subroutine prodmat3(a1,a2,kk,transp,prod)
10120 !DIR$ INLINEALWAYS prodmat3
10122 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
10126 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
10128 crc double precision auxmat(2,2),prod_(2,2)
10131 crc call transpose2(kk(1,1),auxmat(1,1))
10132 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10133 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10135 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
10136 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10137 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
10138 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10139 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
10140 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10141 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
10142 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10145 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10146 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10148 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
10149 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10150 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
10151 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10152 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
10153 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10154 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
10155 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10158 c call transpose2(a2(1,1),a2t(1,1))
10161 crc print *,((prod_(i,j),i=1,2),j=1,2)
10162 crc print *,((prod(i,j),i=1,2),j=1,2)
10166 CCC----------------------------------------------
10167 subroutine Eliptransfer(eliptran)
10168 implicit real*8 (a-h,o-z)
10169 include 'DIMENSIONS'
10170 include 'COMMON.GEO'
10171 include 'COMMON.VAR'
10172 include 'COMMON.LOCAL'
10173 include 'COMMON.CHAIN'
10174 include 'COMMON.DERIV'
10175 include 'COMMON.NAMES'
10176 include 'COMMON.INTERACT'
10177 include 'COMMON.IOUNITS'
10178 include 'COMMON.CALC'
10179 include 'COMMON.CONTROL'
10180 include 'COMMON.SPLITELE'
10181 include 'COMMON.SBRIDGE'
10182 C this is done by Adasko
10183 C print *,"wchodze"
10184 C structure of box:
10186 C--bordliptop-- buffore starts
10187 C--bufliptop--- here true lipid starts
10189 C--buflipbot--- lipid ends buffore starts
10190 C--bordlipbot--buffore ends
10192 do i=ilip_start,ilip_end
10194 if (itype(i).eq.ntyp1) cycle
10196 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
10197 if (positi.le.0) positi=positi+boxzsize
10199 C first for peptide groups
10200 c for each residue check if it is in lipid or lipid water border area
10201 if ((positi.gt.bordlipbot)
10202 &.and.(positi.lt.bordliptop)) then
10203 C the energy transfer exist
10204 if (positi.lt.buflipbot) then
10205 C what fraction I am in
10207 & ((positi-bordlipbot)/lipbufthick)
10208 C lipbufthick is thickenes of lipid buffore
10209 sslip=sscalelip(fracinbuf)
10210 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10211 eliptran=eliptran+sslip*pepliptran
10212 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10213 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10214 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10216 C print *,"doing sccale for lower part"
10217 C print *,i,sslip,fracinbuf,ssgradlip
10218 elseif (positi.gt.bufliptop) then
10219 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
10220 sslip=sscalelip(fracinbuf)
10221 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10222 eliptran=eliptran+sslip*pepliptran
10223 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10224 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10225 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10226 C print *, "doing sscalefor top part"
10227 C print *,i,sslip,fracinbuf,ssgradlip
10229 eliptran=eliptran+pepliptran
10230 C print *,"I am in true lipid"
10233 C eliptran=elpitran+0.0 ! I am in water
10236 C print *, "nic nie bylo w lipidzie?"
10237 C now multiply all by the peptide group transfer factor
10238 C eliptran=eliptran*pepliptran
10239 C now the same for side chains
10241 do i=ilip_start,ilip_end
10242 if (itype(i).eq.ntyp1) cycle
10243 positi=(mod(c(3,i+nres),boxzsize))
10244 if (positi.le.0) positi=positi+boxzsize
10245 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
10246 c for each residue check if it is in lipid or lipid water border area
10247 C respos=mod(c(3,i+nres),boxzsize)
10248 C print *,positi,bordlipbot,buflipbot
10249 if ((positi.gt.bordlipbot)
10250 & .and.(positi.lt.bordliptop)) then
10251 C the energy transfer exist
10252 if (positi.lt.buflipbot) then
10254 & ((positi-bordlipbot)/lipbufthick)
10255 C lipbufthick is thickenes of lipid buffore
10256 sslip=sscalelip(fracinbuf)
10257 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10258 eliptran=eliptran+sslip*liptranene(itype(i))
10259 gliptranx(3,i)=gliptranx(3,i)
10260 &+ssgradlip*liptranene(itype(i))
10261 gliptranc(3,i-1)= gliptranc(3,i-1)
10262 &+ssgradlip*liptranene(itype(i))
10263 C print *,"doing sccale for lower part"
10264 elseif (positi.gt.bufliptop) then
10266 &((bordliptop-positi)/lipbufthick)
10267 sslip=sscalelip(fracinbuf)
10268 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10269 eliptran=eliptran+sslip*liptranene(itype(i))
10270 gliptranx(3,i)=gliptranx(3,i)
10271 &+ssgradlip*liptranene(itype(i))
10272 gliptranc(3,i-1)= gliptranc(3,i-1)
10273 &+ssgradlip*liptranene(itype(i))
10274 C print *, "doing sscalefor top part",sslip,fracinbuf
10276 eliptran=eliptran+liptranene(itype(i))
10277 C print *,"I am in true lipid"
10279 endif ! if in lipid or buffor
10281 C eliptran=elpitran+0.0 ! I am in water
10285 C---------------------------------------------------------
10286 C AFM soubroutine for constant force
10287 subroutine AFMforce(Eafmforce)
10288 implicit real*8 (a-h,o-z)
10289 include 'DIMENSIONS'
10290 include 'COMMON.GEO'
10291 include 'COMMON.VAR'
10292 include 'COMMON.LOCAL'
10293 include 'COMMON.CHAIN'
10294 include 'COMMON.DERIV'
10295 include 'COMMON.NAMES'
10296 include 'COMMON.INTERACT'
10297 include 'COMMON.IOUNITS'
10298 include 'COMMON.CALC'
10299 include 'COMMON.CONTROL'
10300 include 'COMMON.SPLITELE'
10301 include 'COMMON.SBRIDGE'
10306 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10307 dist=dist+diffafm(i)**2
10310 Eafmforce=-forceAFMconst*(dist-distafminit)
10312 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
10313 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
10315 C print *,'AFM',Eafmforce
10318 C---------------------------------------------------------
10319 C AFM subroutine with pseudoconstant velocity
10320 subroutine AFMvel(Eafmforce)
10321 implicit real*8 (a-h,o-z)
10322 include 'DIMENSIONS'
10323 include 'COMMON.GEO'
10324 include 'COMMON.VAR'
10325 include 'COMMON.LOCAL'
10326 include 'COMMON.CHAIN'
10327 include 'COMMON.DERIV'
10328 include 'COMMON.NAMES'
10329 include 'COMMON.INTERACT'
10330 include 'COMMON.IOUNITS'
10331 include 'COMMON.CALC'
10332 include 'COMMON.CONTROL'
10333 include 'COMMON.SPLITELE'
10334 include 'COMMON.SBRIDGE'
10336 C Only for check grad COMMENT if not used for checkgrad
10338 C--------------------------------------------------------
10339 C print *,"wchodze"
10343 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10344 dist=dist+diffafm(i)**2
10347 Eafmforce=0.5d0*forceAFMconst
10348 & *(distafminit+totTafm*velAFMconst-dist)**2
10349 C Eafmforce=-forceAFMconst*(dist-distafminit)
10351 gradafm(i,afmend-1)=-forceAFMconst*
10352 &(distafminit+totTafm*velAFMconst-dist)
10354 gradafm(i,afmbeg-1)=forceAFMconst*
10355 &(distafminit+totTafm*velAFMconst-dist)
10358 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist