1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
27 include 'COMMON.SPLITELE'
29 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
30 c & " nfgtasks",nfgtasks
31 if (nfgtasks.gt.1) then
33 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
34 if (fg_rank.eq.0) then
35 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
36 c print *,"Processor",myrank," BROADCAST iorder"
37 C FG master sets up the WEIGHTS_ array which will be broadcast to the
38 C FG slaves as WEIGHTS array.
58 C FG Master broadcasts the WEIGHTS_ array
59 call MPI_Bcast(weights_(1),n_ene,
60 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
62 C FG slaves receive the WEIGHTS array
63 call MPI_Bcast(weights(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
85 time_Bcast=time_Bcast+MPI_Wtime()-time00
86 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
87 c call chainbuild_cart
89 c print *,'Processor',myrank,' calling etotal ipot=',ipot
90 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
92 c if (modecalc.eq.12.or.modecalc.eq.14) then
93 c call int_from_cart1(.false.)
100 C Compute the side-chain and electrostatic interaction energy
103 goto (101,102,103,104,105,106) ipot
104 C Lennard-Jones potential.
106 cd print '(a)','Exit ELJ'
108 C Lennard-Jones-Kihara potential (shifted).
111 C Berne-Pechukas potential (dilated LJ, angular dependence).
114 C Gay-Berne potential (shifted LJ, angular dependence).
116 C print *,"bylem w egb"
118 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
121 C Soft-sphere potential
122 106 call e_softsphere(evdw)
124 C Calculate electrostatic (H-bonding) energy of the main chain.
128 cmc Sep-06: egb takes care of dynamic ss bonds too
130 c if (dyn_ss) call dyn_set_nss
132 c print *,"Processor",myrank," computed USCSC"
138 time_vec=time_vec+MPI_Wtime()-time01
140 c print *,"Processor",myrank," left VEC_AND_DERIV"
143 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
144 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
145 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
146 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
148 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
149 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
150 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
151 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
153 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
162 write (iout,*) "Soft-spheer ELEC potential"
163 c call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
166 c print *,"Processor",myrank," computed UELEC"
168 C Calculate excluded-volume interaction energy between peptide groups
173 call escp(evdw2,evdw2_14)
179 c write (iout,*) "Soft-sphere SCP potential"
180 call escp_soft_sphere(evdw2,evdw2_14)
183 c Calculate the bond-stretching energy
187 C Calculate the disulfide-bridge and other energy and the contributions
188 C from other distance constraints.
189 cd print *,'Calling EHPB'
191 cd print *,'EHPB exitted succesfully.'
193 C Calculate the virtual-bond-angle energy.
195 if (wang.gt.0d0) then
200 c print *,"Processor",myrank," computed UB"
202 C Calculate the SC local energy.
204 C print *,"TU DOCHODZE?"
206 c print *,"Processor",myrank," computed USC"
208 C Calculate the virtual-bond torsional energy.
210 cd print *,'nterm=',nterm
212 call etor(etors,edihcnstr)
217 c print *,"Processor",myrank," computed Utor"
219 C 6/23/01 Calculate double-torsional energy
221 if (wtor_d.gt.0) then
226 c print *,"Processor",myrank," computed Utord"
228 C 21/5/07 Calculate local sicdechain correlation energy
230 if (wsccor.gt.0.0d0) then
231 call eback_sc_corr(esccor)
235 C print *,"PRZED MULIt"
236 c print *,"Processor",myrank," computed Usccorr"
238 C 12/1/95 Multi-body terms
242 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
243 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
244 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
245 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
246 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
253 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
254 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
255 cd write (iout,*) "multibody_hb ecorr",ecorr
257 c print *,"Processor",myrank," computed Ucorr"
259 C If performing constraint dynamics, call the constraint energy
260 C after the equilibration time
261 if(usampl.and.totT.gt.eq_time) then
268 C 01/27/2015 added by adasko
269 C the energy component below is energy transfer into lipid environment
270 C based on partition function
271 C print *,"przed lipidami"
272 if (wliptran.gt.0) then
273 call Eliptransfer(eliptran)
275 C print *,"za lipidami"
276 if (AFMlog.gt.0) then
277 call AFMforce(Eafmforce)
280 time_enecalc=time_enecalc+MPI_Wtime()-time00
282 c print *,"Processor",myrank," computed Uconstr"
291 energia(2)=evdw2-evdw2_14
308 energia(8)=eello_turn3
309 energia(9)=eello_turn4
316 energia(19)=edihcnstr
318 energia(20)=Uconst+Uconst_back
321 energia(23)=Eafmforce
322 c Here are the energies showed per procesor if the are more processors
323 c per molecule then we sum it up in sum_energy subroutine
324 c print *," Processor",myrank," calls SUM_ENERGY"
325 call sum_energy(energia,.true.)
326 if (dyn_ss) call dyn_set_nss
327 c print *," Processor",myrank," left SUM_ENERGY"
329 time_sumene=time_sumene+MPI_Wtime()-time00
333 c-------------------------------------------------------------------------------
334 subroutine sum_energy(energia,reduce)
335 implicit real*8 (a-h,o-z)
340 cMS$ATTRIBUTES C :: proc_proc
346 include 'COMMON.SETUP'
347 include 'COMMON.IOUNITS'
348 double precision energia(0:n_ene),enebuff(0:n_ene+1)
349 include 'COMMON.FFIELD'
350 include 'COMMON.DERIV'
351 include 'COMMON.INTERACT'
352 include 'COMMON.SBRIDGE'
353 include 'COMMON.CHAIN'
355 include 'COMMON.CONTROL'
356 include 'COMMON.TIME1'
359 if (nfgtasks.gt.1 .and. reduce) then
361 write (iout,*) "energies before REDUCE"
362 call enerprint(energia)
366 enebuff(i)=energia(i)
369 call MPI_Barrier(FG_COMM,IERR)
370 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
372 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
373 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
375 write (iout,*) "energies after REDUCE"
376 call enerprint(energia)
379 time_Reduce=time_Reduce+MPI_Wtime()-time00
381 if (fg_rank.eq.0) then
385 evdw2=energia(2)+energia(18)
401 eello_turn3=energia(8)
402 eello_turn4=energia(9)
409 edihcnstr=energia(19)
414 Eafmforce=energia(23)
416 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
417 & +wang*ebe+wtor*etors+wscloc*escloc
418 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
419 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
420 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
421 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+Eafmforce
423 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
424 & +wang*ebe+wtor*etors+wscloc*escloc
425 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
426 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
427 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
428 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran
435 if (isnan(etot).ne.0) energia(0)=1.0d+99
437 if (isnan(etot)) energia(0)=1.0d+99
442 idumm=proc_proc(etot,i)
444 call proc_proc(etot,i)
446 if(i.eq.1)energia(0)=1.0d+99
453 c-------------------------------------------------------------------------------
454 subroutine sum_gradient
455 implicit real*8 (a-h,o-z)
460 cMS$ATTRIBUTES C :: proc_proc
466 double precision gradbufc(3,-1:maxres),gradbufx(3,-1:maxres),
467 & glocbuf(4*maxres),gradbufc_sum(3,-1:maxres)
468 & ,gloc_scbuf(3,-1:maxres)
469 include 'COMMON.SETUP'
470 include 'COMMON.IOUNITS'
471 include 'COMMON.FFIELD'
472 include 'COMMON.DERIV'
473 include 'COMMON.INTERACT'
474 include 'COMMON.SBRIDGE'
475 include 'COMMON.CHAIN'
477 include 'COMMON.CONTROL'
478 include 'COMMON.TIME1'
479 include 'COMMON.MAXGRAD'
480 include 'COMMON.SCCOR'
485 write (iout,*) "sum_gradient gvdwc, gvdwx"
487 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
488 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
493 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
494 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
495 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
498 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
499 C in virtual-bond-vector coordinates
502 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
504 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
505 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
507 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
509 c write (iout,'(i5,3f10.5,2x,f10.5)')
510 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
512 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
514 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
515 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
523 gradbufc(j,i)=wsc*gvdwc(j,i)+
524 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
525 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
526 & wel_loc*gel_loc_long(j,i)+
527 & wcorr*gradcorr_long(j,i)+
528 & wcorr5*gradcorr5_long(j,i)+
529 & wcorr6*gradcorr6_long(j,i)+
530 & wturn6*gcorr6_turn_long(j,i)+
532 & +wliptran*gliptranc(j,i)
540 gradbufc(j,i)=wsc*gvdwc(j,i)+
541 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
542 & welec*gelc_long(j,i)+
544 & wel_loc*gel_loc_long(j,i)+
545 & wcorr*gradcorr_long(j,i)+
546 & wcorr5*gradcorr5_long(j,i)+
547 & wcorr6*gradcorr6_long(j,i)+
548 & wturn6*gcorr6_turn_long(j,i)+
550 & +wliptran*gliptranc(j,i)
557 if (nfgtasks.gt.1) then
560 write (iout,*) "gradbufc before allreduce"
562 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
568 gradbufc_sum(j,i)=gradbufc(j,i)
571 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
572 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
573 c time_reduce=time_reduce+MPI_Wtime()-time00
575 c write (iout,*) "gradbufc_sum after allreduce"
577 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
582 c time_allreduce=time_allreduce+MPI_Wtime()-time00
590 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
591 write (iout,*) (i," jgrad_start",jgrad_start(i),
592 & " jgrad_end ",jgrad_end(i),
593 & i=igrad_start,igrad_end)
596 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
597 c do not parallelize this part.
599 c do i=igrad_start,igrad_end
600 c do j=jgrad_start(i),jgrad_end(i)
602 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
607 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
611 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
615 write (iout,*) "gradbufc after summing"
617 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
624 write (iout,*) "gradbufc"
626 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
632 gradbufc_sum(j,i)=gradbufc(j,i)
637 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
641 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
646 c gradbufc(k,i)=0.0d0
650 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
655 write (iout,*) "gradbufc after summing"
657 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
665 gradbufc(k,nres)=0.0d0
670 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
671 & wel_loc*gel_loc(j,i)+
672 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
673 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
674 & wel_loc*gel_loc_long(j,i)+
675 & wcorr*gradcorr_long(j,i)+
676 & wcorr5*gradcorr5_long(j,i)+
677 & wcorr6*gradcorr6_long(j,i)+
678 & wturn6*gcorr6_turn_long(j,i))+
680 & wcorr*gradcorr(j,i)+
681 & wturn3*gcorr3_turn(j,i)+
682 & wturn4*gcorr4_turn(j,i)+
683 & wcorr5*gradcorr5(j,i)+
684 & wcorr6*gradcorr6(j,i)+
685 & wturn6*gcorr6_turn(j,i)+
686 & wsccor*gsccorc(j,i)
687 & +wscloc*gscloc(j,i)
688 & +wliptran*gliptranc(j,i)
691 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
692 & wel_loc*gel_loc(j,i)+
693 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
694 & welec*gelc_long(j,i)
695 & wel_loc*gel_loc_long(j,i)+
696 & wcorr*gcorr_long(j,i)+
697 & wcorr5*gradcorr5_long(j,i)+
698 & wcorr6*gradcorr6_long(j,i)+
699 & wturn6*gcorr6_turn_long(j,i))+
701 & wcorr*gradcorr(j,i)+
702 & wturn3*gcorr3_turn(j,i)+
703 & wturn4*gcorr4_turn(j,i)+
704 & wcorr5*gradcorr5(j,i)+
705 & wcorr6*gradcorr6(j,i)+
706 & wturn6*gcorr6_turn(j,i)+
707 & wsccor*gsccorc(j,i)
708 & +wscloc*gscloc(j,i)
709 & +wliptran*gliptranc(j,i)
713 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
715 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
716 & wsccor*gsccorx(j,i)
717 & +wscloc*gsclocx(j,i)
718 & +wliptran*gliptranx(j,i)
722 write (iout,*) "gloc before adding corr"
724 write (iout,*) i,gloc(i,icg)
728 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
729 & +wcorr5*g_corr5_loc(i)
730 & +wcorr6*g_corr6_loc(i)
731 & +wturn4*gel_loc_turn4(i)
732 & +wturn3*gel_loc_turn3(i)
733 & +wturn6*gel_loc_turn6(i)
734 & +wel_loc*gel_loc_loc(i)
737 write (iout,*) "gloc after adding corr"
739 write (iout,*) i,gloc(i,icg)
743 if (nfgtasks.gt.1) then
746 gradbufc(j,i)=gradc(j,i,icg)
747 gradbufx(j,i)=gradx(j,i,icg)
751 glocbuf(i)=gloc(i,icg)
755 write (iout,*) "gloc_sc before reduce"
758 write (iout,*) i,j,gloc_sc(j,i,icg)
765 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
769 call MPI_Barrier(FG_COMM,IERR)
770 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
772 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
773 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
774 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
775 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
776 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
777 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
778 time_reduce=time_reduce+MPI_Wtime()-time00
779 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
780 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
781 time_reduce=time_reduce+MPI_Wtime()-time00
784 write (iout,*) "gloc_sc after reduce"
787 write (iout,*) i,j,gloc_sc(j,i,icg)
793 write (iout,*) "gloc after reduce"
795 write (iout,*) i,gloc(i,icg)
800 if (gnorm_check) then
802 c Compute the maximum elements of the gradient
812 gcorr3_turn_max=0.0d0
813 gcorr4_turn_max=0.0d0
816 gcorr6_turn_max=0.0d0
826 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
827 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
828 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
829 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
830 & gvdwc_scp_max=gvdwc_scp_norm
831 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
832 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
833 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
834 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
835 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
836 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
837 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
838 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
839 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
840 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
841 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
842 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
843 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
845 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
846 & gcorr3_turn_max=gcorr3_turn_norm
847 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
849 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
850 & gcorr4_turn_max=gcorr4_turn_norm
851 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
852 if (gradcorr5_norm.gt.gradcorr5_max)
853 & gradcorr5_max=gradcorr5_norm
854 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
855 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
856 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
858 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
859 & gcorr6_turn_max=gcorr6_turn_norm
860 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
861 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
862 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
863 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
864 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
865 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
866 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
867 if (gradx_scp_norm.gt.gradx_scp_max)
868 & gradx_scp_max=gradx_scp_norm
869 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
870 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
871 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
872 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
873 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
874 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
875 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
876 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
880 open(istat,file=statname,position="append")
882 open(istat,file=statname,access="append")
884 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
885 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
886 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
887 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
888 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
889 & gsccorx_max,gsclocx_max
891 if (gvdwc_max.gt.1.0d4) then
892 write (iout,*) "gvdwc gvdwx gradb gradbx"
894 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
895 & gradb(j,i),gradbx(j,i),j=1,3)
897 call pdbout(0.0d0,'cipiszcze',iout)
903 write (iout,*) "gradc gradx gloc"
905 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
906 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
910 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
914 c-------------------------------------------------------------------------------
915 subroutine rescale_weights(t_bath)
916 implicit real*8 (a-h,o-z)
918 include 'COMMON.IOUNITS'
919 include 'COMMON.FFIELD'
920 include 'COMMON.SBRIDGE'
921 double precision kfac /2.4d0/
922 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
924 c facT=2*temp0/(t_bath+temp0)
925 if (rescale_mode.eq.0) then
931 else if (rescale_mode.eq.1) then
932 facT=kfac/(kfac-1.0d0+t_bath/temp0)
933 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
934 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
935 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
936 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
937 else if (rescale_mode.eq.2) then
943 facT=licznik/dlog(dexp(x)+dexp(-x))
944 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
945 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
946 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
947 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
949 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
950 write (*,*) "Wrong RESCALE_MODE",rescale_mode
952 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
956 welec=weights(3)*fact
957 wcorr=weights(4)*fact3
958 wcorr5=weights(5)*fact4
959 wcorr6=weights(6)*fact5
960 wel_loc=weights(7)*fact2
961 wturn3=weights(8)*fact2
962 wturn4=weights(9)*fact3
963 wturn6=weights(10)*fact5
964 wtor=weights(13)*fact
965 wtor_d=weights(14)*fact2
966 wsccor=weights(21)*fact
970 C------------------------------------------------------------------------
971 subroutine enerprint(energia)
972 implicit real*8 (a-h,o-z)
974 include 'COMMON.IOUNITS'
975 include 'COMMON.FFIELD'
976 include 'COMMON.SBRIDGE'
978 double precision energia(0:n_ene)
983 evdw2=energia(2)+energia(18)
995 eello_turn3=energia(8)
996 eello_turn4=energia(9)
997 eello_turn6=energia(10)
1003 edihcnstr=energia(19)
1007 eliptran=energia(22)
1008 Eafmforce=energia(23)
1010 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1011 & estr,wbond,ebe,wang,
1012 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1014 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1015 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1016 & edihcnstr,ebr*nss,
1017 & Uconst,eliptran,wliptran,Eafmforce,etot
1018 10 format (/'Virtual-chain energies:'//
1019 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1020 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1021 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1022 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1023 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1024 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1025 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1026 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1027 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1028 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1029 & ' (SS bridges & dist. cnstr.)'/
1030 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1031 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1032 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1033 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1034 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1035 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1036 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1037 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1038 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1039 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1040 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1041 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1042 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1043 & 'ETOT= ',1pE16.6,' (total)')
1046 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1047 & estr,wbond,ebe,wang,
1048 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1050 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1051 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1052 & ebr*nss,Uconst,eliptran,wliptran,Eafmforc,etot
1053 10 format (/'Virtual-chain energies:'//
1054 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1055 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1056 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1057 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1058 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1059 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1060 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1061 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1062 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1063 & ' (SS bridges & dist. cnstr.)'/
1064 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1065 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1066 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1067 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1068 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1069 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1070 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1071 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1072 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1073 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1074 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1075 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1076 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1077 & 'ETOT= ',1pE16.6,' (total)')
1081 C-----------------------------------------------------------------------
1082 subroutine elj(evdw)
1084 C This subroutine calculates the interaction energy of nonbonded side chains
1085 C assuming the LJ potential of interaction.
1087 implicit real*8 (a-h,o-z)
1088 include 'DIMENSIONS'
1089 parameter (accur=1.0d-10)
1090 include 'COMMON.GEO'
1091 include 'COMMON.VAR'
1092 include 'COMMON.LOCAL'
1093 include 'COMMON.CHAIN'
1094 include 'COMMON.DERIV'
1095 include 'COMMON.INTERACT'
1096 include 'COMMON.TORSION'
1097 include 'COMMON.SBRIDGE'
1098 include 'COMMON.NAMES'
1099 include 'COMMON.IOUNITS'
1100 include 'COMMON.CONTACTS'
1102 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1104 do i=iatsc_s,iatsc_e
1105 itypi=iabs(itype(i))
1106 if (itypi.eq.ntyp1) cycle
1107 itypi1=iabs(itype(i+1))
1114 C Calculate SC interaction energy.
1116 do iint=1,nint_gr(i)
1117 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1118 cd & 'iend=',iend(i,iint)
1119 do j=istart(i,iint),iend(i,iint)
1120 itypj=iabs(itype(j))
1121 if (itypj.eq.ntyp1) cycle
1125 C Change 12/1/95 to calculate four-body interactions
1126 rij=xj*xj+yj*yj+zj*zj
1128 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1129 eps0ij=eps(itypi,itypj)
1131 C have you changed here?
1135 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1136 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1137 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1138 cd & restyp(itypi),i,restyp(itypj),j,a(itypi,itypj),
1139 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1140 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1143 C Calculate the components of the gradient in DC and X
1145 fac=-rrij*(e1+evdwij)
1150 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1151 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1152 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1153 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1157 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1161 C 12/1/95, revised on 5/20/97
1163 C Calculate the contact function. The ith column of the array JCONT will
1164 C contain the numbers of atoms that make contacts with the atom I (of numbers
1165 C greater than I). The arrays FACONT and GACONT will contain the values of
1166 C the contact function and its derivative.
1168 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1169 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1170 C Uncomment next line, if the correlation interactions are contact function only
1171 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1173 sigij=sigma(itypi,itypj)
1174 r0ij=rs0(itypi,itypj)
1176 C Check whether the SC's are not too far to make a contact.
1179 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1180 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1182 if (fcont.gt.0.0D0) then
1183 C If the SC-SC distance if close to sigma, apply spline.
1184 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1185 cAdam & fcont1,fprimcont1)
1186 cAdam fcont1=1.0d0-fcont1
1187 cAdam if (fcont1.gt.0.0d0) then
1188 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1189 cAdam fcont=fcont*fcont1
1191 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1192 cga eps0ij=1.0d0/dsqrt(eps0ij)
1194 cga gg(k)=gg(k)*eps0ij
1196 cga eps0ij=-evdwij*eps0ij
1197 C Uncomment for AL's type of SC correlation interactions.
1198 cadam eps0ij=-evdwij
1199 num_conti=num_conti+1
1200 jcont(num_conti,i)=j
1201 facont(num_conti,i)=fcont*eps0ij
1202 fprimcont=eps0ij*fprimcont/rij
1204 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1205 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1206 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1207 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1208 gacont(1,num_conti,i)=-fprimcont*xj
1209 gacont(2,num_conti,i)=-fprimcont*yj
1210 gacont(3,num_conti,i)=-fprimcont*zj
1211 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1212 cd write (iout,'(2i3,3f10.5)')
1213 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1219 num_cont(i)=num_conti
1223 gvdwc(j,i)=expon*gvdwc(j,i)
1224 gvdwx(j,i)=expon*gvdwx(j,i)
1227 C******************************************************************************
1231 C To save time, the factor of EXPON has been extracted from ALL components
1232 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1235 C******************************************************************************
1238 C-----------------------------------------------------------------------------
1239 subroutine eljk(evdw)
1241 C This subroutine calculates the interaction energy of nonbonded side chains
1242 C assuming the LJK potential of interaction.
1244 implicit real*8 (a-h,o-z)
1245 include 'DIMENSIONS'
1246 include 'COMMON.GEO'
1247 include 'COMMON.VAR'
1248 include 'COMMON.LOCAL'
1249 include 'COMMON.CHAIN'
1250 include 'COMMON.DERIV'
1251 include 'COMMON.INTERACT'
1252 include 'COMMON.IOUNITS'
1253 include 'COMMON.NAMES'
1256 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1258 do i=iatsc_s,iatsc_e
1259 itypi=iabs(itype(i))
1260 if (itypi.eq.ntyp1) cycle
1261 itypi1=iabs(itype(i+1))
1266 C Calculate SC interaction energy.
1268 do iint=1,nint_gr(i)
1269 do j=istart(i,iint),iend(i,iint)
1270 itypj=iabs(itype(j))
1271 if (itypj.eq.ntyp1) cycle
1275 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1276 fac_augm=rrij**expon
1277 e_augm=augm(itypi,itypj)*fac_augm
1278 r_inv_ij=dsqrt(rrij)
1280 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1281 fac=r_shift_inv**expon
1282 C have you changed here?
1286 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1287 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1288 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1289 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1290 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1291 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1292 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1295 C Calculate the components of the gradient in DC and X
1297 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1302 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1303 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1304 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1305 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1309 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1317 gvdwc(j,i)=expon*gvdwc(j,i)
1318 gvdwx(j,i)=expon*gvdwx(j,i)
1323 C-----------------------------------------------------------------------------
1324 subroutine ebp(evdw)
1326 C This subroutine calculates the interaction energy of nonbonded side chains
1327 C assuming the Berne-Pechukas potential of interaction.
1329 implicit real*8 (a-h,o-z)
1330 include 'DIMENSIONS'
1331 include 'COMMON.GEO'
1332 include 'COMMON.VAR'
1333 include 'COMMON.LOCAL'
1334 include 'COMMON.CHAIN'
1335 include 'COMMON.DERIV'
1336 include 'COMMON.NAMES'
1337 include 'COMMON.INTERACT'
1338 include 'COMMON.IOUNITS'
1339 include 'COMMON.CALC'
1340 common /srutu/ icall
1341 c double precision rrsave(maxdim)
1344 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1346 c if (icall.eq.0) then
1352 do i=iatsc_s,iatsc_e
1353 itypi=iabs(itype(i))
1354 if (itypi.eq.ntyp1) cycle
1355 itypi1=iabs(itype(i+1))
1359 dxi=dc_norm(1,nres+i)
1360 dyi=dc_norm(2,nres+i)
1361 dzi=dc_norm(3,nres+i)
1362 c dsci_inv=dsc_inv(itypi)
1363 dsci_inv=vbld_inv(i+nres)
1365 C Calculate SC interaction energy.
1367 do iint=1,nint_gr(i)
1368 do j=istart(i,iint),iend(i,iint)
1370 itypj=iabs(itype(j))
1371 if (itypj.eq.ntyp1) cycle
1372 c dscj_inv=dsc_inv(itypj)
1373 dscj_inv=vbld_inv(j+nres)
1374 chi1=chi(itypi,itypj)
1375 chi2=chi(itypj,itypi)
1382 alf12=0.5D0*(alf1+alf2)
1383 C For diagnostics only!!!
1396 dxj=dc_norm(1,nres+j)
1397 dyj=dc_norm(2,nres+j)
1398 dzj=dc_norm(3,nres+j)
1399 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1400 cd if (icall.eq.0) then
1406 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1408 C Calculate whole angle-dependent part of epsilon and contributions
1409 C to its derivatives
1410 C have you changed here?
1411 fac=(rrij*sigsq)**expon2
1414 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1415 eps2der=evdwij*eps3rt
1416 eps3der=evdwij*eps2rt
1417 evdwij=evdwij*eps2rt*eps3rt
1420 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1422 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1423 cd & restyp(itypi),i,restyp(itypj),j,
1424 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1425 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1426 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1429 C Calculate gradient components.
1430 e1=e1*eps1*eps2rt**2*eps3rt**2
1431 fac=-expon*(e1+evdwij)
1434 C Calculate radial part of the gradient
1438 C Calculate the angular part of the gradient and sum add the contributions
1439 C to the appropriate components of the Cartesian gradient.
1447 C-----------------------------------------------------------------------------
1448 subroutine egb(evdw)
1450 C This subroutine calculates the interaction energy of nonbonded side chains
1451 C assuming the Gay-Berne potential of interaction.
1453 implicit real*8 (a-h,o-z)
1454 include 'DIMENSIONS'
1455 include 'COMMON.GEO'
1456 include 'COMMON.VAR'
1457 include 'COMMON.LOCAL'
1458 include 'COMMON.CHAIN'
1459 include 'COMMON.DERIV'
1460 include 'COMMON.NAMES'
1461 include 'COMMON.INTERACT'
1462 include 'COMMON.IOUNITS'
1463 include 'COMMON.CALC'
1464 include 'COMMON.CONTROL'
1465 include 'COMMON.SPLITELE'
1466 include 'COMMON.SBRIDGE'
1468 integer xshift,yshift,zshift
1470 ccccc energy_dec=.false.
1471 C print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1474 c if (icall.eq.0) lprn=.false.
1476 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1477 C we have the original box)
1481 do i=iatsc_s,iatsc_e
1482 itypi=iabs(itype(i))
1483 if (itypi.eq.ntyp1) cycle
1484 itypi1=iabs(itype(i+1))
1488 C Return atom into box, boxxsize is size of box in x dimension
1490 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1491 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1492 C Condition for being inside the proper box
1493 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1494 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1498 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1499 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1500 C Condition for being inside the proper box
1501 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1502 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1506 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1507 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1508 C Condition for being inside the proper box
1509 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1510 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1514 if (xi.lt.0) xi=xi+boxxsize
1516 if (yi.lt.0) yi=yi+boxysize
1518 if (zi.lt.0) zi=zi+boxzsize
1519 C define scaling factor for lipids
1521 C if (positi.le.0) positi=positi+boxzsize
1523 C first for peptide groups
1524 c for each residue check if it is in lipid or lipid water border area
1525 if ((zi.gt.bordlipbot)
1526 &.and.(zi.lt.bordliptop)) then
1527 C the energy transfer exist
1528 if (zi.lt.buflipbot) then
1529 C what fraction I am in
1531 & ((zi-bordlipbot)/lipbufthick)
1532 C lipbufthick is thickenes of lipid buffore
1533 sslipi=sscalelip(fracinbuf)
1534 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1535 elseif (zi.gt.bufliptop) then
1536 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1537 sslipi=sscalelip(fracinbuf)
1538 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1548 C xi=xi+xshift*boxxsize
1549 C yi=yi+yshift*boxysize
1550 C zi=zi+zshift*boxzsize
1552 dxi=dc_norm(1,nres+i)
1553 dyi=dc_norm(2,nres+i)
1554 dzi=dc_norm(3,nres+i)
1555 c dsci_inv=dsc_inv(itypi)
1556 dsci_inv=vbld_inv(i+nres)
1557 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1558 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1560 C Calculate SC interaction energy.
1562 do iint=1,nint_gr(i)
1563 do j=istart(i,iint),iend(i,iint)
1564 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1565 call dyn_ssbond_ene(i,j,evdwij)
1567 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1568 & 'evdw',i,j,evdwij,' ss'
1571 itypj=iabs(itype(j))
1572 if (itypj.eq.ntyp1) cycle
1573 c dscj_inv=dsc_inv(itypj)
1574 dscj_inv=vbld_inv(j+nres)
1575 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1576 c & 1.0d0/vbld(j+nres)
1577 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1578 sig0ij=sigma(itypi,itypj)
1579 chi1=chi(itypi,itypj)
1580 chi2=chi(itypj,itypi)
1587 alf12=0.5D0*(alf1+alf2)
1588 C For diagnostics only!!!
1601 C Return atom J into box the original box
1603 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1604 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1605 C Condition for being inside the proper box
1606 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1607 c & (xj.lt.((-0.5d0)*boxxsize))) then
1611 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1612 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1613 C Condition for being inside the proper box
1614 c if ((yj.gt.((0.5d0)*boxysize)).or.
1615 c & (yj.lt.((-0.5d0)*boxysize))) then
1619 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1620 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1621 C Condition for being inside the proper box
1622 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1623 c & (zj.lt.((-0.5d0)*boxzsize))) then
1627 if (xj.lt.0) xj=xj+boxxsize
1629 if (yj.lt.0) yj=yj+boxysize
1631 if (zj.lt.0) zj=zj+boxzsize
1632 if ((zj.gt.bordlipbot)
1633 &.and.(zj.lt.bordliptop)) then
1634 C the energy transfer exist
1635 if (zj.lt.buflipbot) then
1636 C what fraction I am in
1638 & ((zj-bordlipbot)/lipbufthick)
1639 C lipbufthick is thickenes of lipid buffore
1640 sslipj=sscalelip(fracinbuf)
1641 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1642 elseif (zj.gt.bufliptop) then
1643 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1644 sslipj=sscalelip(fracinbuf)
1645 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1654 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1655 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1656 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1657 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1658 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'(2e10.5)')
1659 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1660 C if (ssgradlipj.gt.0.0d0) print *,"??WTF??"
1661 C print *,sslipi,sslipj,bordlipbot,zi,zj
1662 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1670 xj=xj_safe+xshift*boxxsize
1671 yj=yj_safe+yshift*boxysize
1672 zj=zj_safe+zshift*boxzsize
1673 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1674 if(dist_temp.lt.dist_init) then
1684 if (subchap.eq.1) then
1693 dxj=dc_norm(1,nres+j)
1694 dyj=dc_norm(2,nres+j)
1695 dzj=dc_norm(3,nres+j)
1699 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1700 c write (iout,*) "j",j," dc_norm",
1701 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1702 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1704 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1705 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1707 c write (iout,'(a7,4f8.3)')
1708 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1709 if (sss.gt.0.0d0) then
1710 C Calculate angle-dependent terms of energy and contributions to their
1714 sig=sig0ij*dsqrt(sigsq)
1715 rij_shift=1.0D0/rij-sig+sig0ij
1716 c for diagnostics; uncomment
1717 c rij_shift=1.2*sig0ij
1718 C I hate to put IF's in the loops, but here don't have another choice!!!!
1719 if (rij_shift.le.0.0D0) then
1721 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1722 cd & restyp(itypi),i,restyp(itypj),j,
1723 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1727 c---------------------------------------------------------------
1728 rij_shift=1.0D0/rij_shift
1729 fac=rij_shift**expon
1730 C here to start with
1735 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1736 eps2der=evdwij*eps3rt
1737 eps3der=evdwij*eps2rt
1738 C write(63,'(2i3,2e10.3,2f10.5)') i,j,aa,bb, evdwij,
1739 C &((sslipi+sslipj)/2.0d0+
1740 C &(2.0d0-sslipi-sslipj)/2.0d0)
1741 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1742 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1743 evdwij=evdwij*eps2rt*eps3rt
1744 evdw=evdw+evdwij*sss
1746 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1748 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1749 & restyp(itypi),i,restyp(itypj),j,
1750 & epsi,sigm,chi1,chi2,chip1,chip2,
1751 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1752 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1756 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1759 C Calculate gradient components.
1760 e1=e1*eps1*eps2rt**2*eps3rt**2
1761 fac=-expon*(e1+evdwij)*rij_shift
1764 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1765 c & evdwij,fac,sigma(itypi,itypj),expon
1766 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1768 C Calculate the radial part of the gradient
1769 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1770 &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1771 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1772 &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1773 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1774 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1780 C Calculate angular part of the gradient.
1790 c write (iout,*) "Number of loop steps in EGB:",ind
1791 cccc energy_dec=.false.
1794 C-----------------------------------------------------------------------------
1795 subroutine egbv(evdw)
1797 C This subroutine calculates the interaction energy of nonbonded side chains
1798 C assuming the Gay-Berne-Vorobjev potential of interaction.
1800 implicit real*8 (a-h,o-z)
1801 include 'DIMENSIONS'
1802 include 'COMMON.GEO'
1803 include 'COMMON.VAR'
1804 include 'COMMON.LOCAL'
1805 include 'COMMON.CHAIN'
1806 include 'COMMON.DERIV'
1807 include 'COMMON.NAMES'
1808 include 'COMMON.INTERACT'
1809 include 'COMMON.IOUNITS'
1810 include 'COMMON.CALC'
1811 common /srutu/ icall
1814 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1817 c if (icall.eq.0) lprn=.true.
1819 do i=iatsc_s,iatsc_e
1820 itypi=iabs(itype(i))
1821 if (itypi.eq.ntyp1) cycle
1822 itypi1=iabs(itype(i+1))
1827 if (xi.lt.0) xi=xi+boxxsize
1829 if (yi.lt.0) yi=yi+boxysize
1831 if (zi.lt.0) zi=zi+boxzsize
1832 C define scaling factor for lipids
1834 C if (positi.le.0) positi=positi+boxzsize
1836 C first for peptide groups
1837 c for each residue check if it is in lipid or lipid water border area
1838 if ((zi.gt.bordlipbot)
1839 &.and.(zi.lt.bordliptop)) then
1840 C the energy transfer exist
1841 if (zi.lt.buflipbot) then
1842 C what fraction I am in
1844 & ((zi-bordlipbot)/lipbufthick)
1845 C lipbufthick is thickenes of lipid buffore
1846 sslipi=sscalelip(fracinbuf)
1847 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1848 elseif (zi.gt.bufliptop) then
1849 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1850 sslipi=sscalelip(fracinbuf)
1851 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1861 dxi=dc_norm(1,nres+i)
1862 dyi=dc_norm(2,nres+i)
1863 dzi=dc_norm(3,nres+i)
1864 c dsci_inv=dsc_inv(itypi)
1865 dsci_inv=vbld_inv(i+nres)
1867 C Calculate SC interaction energy.
1869 do iint=1,nint_gr(i)
1870 do j=istart(i,iint),iend(i,iint)
1872 itypj=iabs(itype(j))
1873 if (itypj.eq.ntyp1) cycle
1874 c dscj_inv=dsc_inv(itypj)
1875 dscj_inv=vbld_inv(j+nres)
1876 sig0ij=sigma(itypi,itypj)
1877 r0ij=r0(itypi,itypj)
1878 chi1=chi(itypi,itypj)
1879 chi2=chi(itypj,itypi)
1886 alf12=0.5D0*(alf1+alf2)
1887 C For diagnostics only!!!
1901 if (xj.lt.0) xj=xj+boxxsize
1903 if (yj.lt.0) yj=yj+boxysize
1905 if (zj.lt.0) zj=zj+boxzsize
1906 if ((zj.gt.bordlipbot)
1907 &.and.(zj.lt.bordliptop)) then
1908 C the energy transfer exist
1909 if (zj.lt.buflipbot) then
1910 C what fraction I am in
1912 & ((zj-bordlipbot)/lipbufthick)
1913 C lipbufthick is thickenes of lipid buffore
1914 sslipj=sscalelip(fracinbuf)
1915 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1916 elseif (zj.gt.bufliptop) then
1917 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1918 sslipj=sscalelip(fracinbuf)
1919 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1928 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1929 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1930 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1931 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1932 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5')
1933 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1934 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1942 xj=xj_safe+xshift*boxxsize
1943 yj=yj_safe+yshift*boxysize
1944 zj=zj_safe+zshift*boxzsize
1945 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1946 if(dist_temp.lt.dist_init) then
1956 if (subchap.eq.1) then
1965 dxj=dc_norm(1,nres+j)
1966 dyj=dc_norm(2,nres+j)
1967 dzj=dc_norm(3,nres+j)
1968 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1970 C Calculate angle-dependent terms of energy and contributions to their
1974 sig=sig0ij*dsqrt(sigsq)
1975 rij_shift=1.0D0/rij-sig+r0ij
1976 C I hate to put IF's in the loops, but here don't have another choice!!!!
1977 if (rij_shift.le.0.0D0) then
1982 c---------------------------------------------------------------
1983 rij_shift=1.0D0/rij_shift
1984 fac=rij_shift**expon
1987 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1988 eps2der=evdwij*eps3rt
1989 eps3der=evdwij*eps2rt
1990 fac_augm=rrij**expon
1991 e_augm=augm(itypi,itypj)*fac_augm
1992 evdwij=evdwij*eps2rt*eps3rt
1993 evdw=evdw+evdwij+e_augm
1995 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1997 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1998 & restyp(itypi),i,restyp(itypj),j,
1999 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
2000 & chi1,chi2,chip1,chip2,
2001 & eps1,eps2rt**2,eps3rt**2,
2002 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
2005 C Calculate gradient components.
2006 e1=e1*eps1*eps2rt**2*eps3rt**2
2007 fac=-expon*(e1+evdwij)*rij_shift
2009 fac=rij*fac-2*expon*rrij*e_augm
2010 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
2011 C Calculate the radial part of the gradient
2015 C Calculate angular part of the gradient.
2021 C-----------------------------------------------------------------------------
2022 subroutine sc_angular
2023 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2024 C om12. Called by ebp, egb, and egbv.
2026 include 'COMMON.CALC'
2027 include 'COMMON.IOUNITS'
2031 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2032 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2033 om12=dxi*dxj+dyi*dyj+dzi*dzj
2035 C Calculate eps1(om12) and its derivative in om12
2036 faceps1=1.0D0-om12*chiom12
2037 faceps1_inv=1.0D0/faceps1
2038 eps1=dsqrt(faceps1_inv)
2039 C Following variable is eps1*deps1/dom12
2040 eps1_om12=faceps1_inv*chiom12
2045 c write (iout,*) "om12",om12," eps1",eps1
2046 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2051 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2052 sigsq=1.0D0-facsig*faceps1_inv
2053 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2054 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2055 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2061 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
2062 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
2064 C Calculate eps2 and its derivatives in om1, om2, and om12.
2067 chipom12=chip12*om12
2068 facp=1.0D0-om12*chipom12
2070 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2071 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2072 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2073 C Following variable is the square root of eps2
2074 eps2rt=1.0D0-facp1*facp_inv
2075 C Following three variables are the derivatives of the square root of eps
2076 C in om1, om2, and om12.
2077 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2078 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2079 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2080 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2081 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2082 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2083 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2084 c & " eps2rt_om12",eps2rt_om12
2085 C Calculate whole angle-dependent part of epsilon and contributions
2086 C to its derivatives
2089 C----------------------------------------------------------------------------
2091 implicit real*8 (a-h,o-z)
2092 include 'DIMENSIONS'
2093 include 'COMMON.CHAIN'
2094 include 'COMMON.DERIV'
2095 include 'COMMON.CALC'
2096 include 'COMMON.IOUNITS'
2097 double precision dcosom1(3),dcosom2(3)
2098 cc print *,'sss=',sss
2099 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2100 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2101 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2102 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2106 c eom12=evdwij*eps1_om12
2108 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2109 c & " sigder",sigder
2110 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2111 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2113 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2114 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2117 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
2119 c write (iout,*) "gg",(gg(k),k=1,3)
2121 gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
2122 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2123 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
2124 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
2125 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2126 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
2127 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2128 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2129 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2130 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2133 C Calculate the components of the gradient in DC and X
2137 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2141 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
2142 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
2146 C-----------------------------------------------------------------------
2147 subroutine e_softsphere(evdw)
2149 C This subroutine calculates the interaction energy of nonbonded side chains
2150 C assuming the LJ potential of interaction.
2152 implicit real*8 (a-h,o-z)
2153 include 'DIMENSIONS'
2154 parameter (accur=1.0d-10)
2155 include 'COMMON.GEO'
2156 include 'COMMON.VAR'
2157 include 'COMMON.LOCAL'
2158 include 'COMMON.CHAIN'
2159 include 'COMMON.DERIV'
2160 include 'COMMON.INTERACT'
2161 include 'COMMON.TORSION'
2162 include 'COMMON.SBRIDGE'
2163 include 'COMMON.NAMES'
2164 include 'COMMON.IOUNITS'
2165 include 'COMMON.CONTACTS'
2167 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2169 do i=iatsc_s,iatsc_e
2170 itypi=iabs(itype(i))
2171 if (itypi.eq.ntyp1) cycle
2172 itypi1=iabs(itype(i+1))
2177 C Calculate SC interaction energy.
2179 do iint=1,nint_gr(i)
2180 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2181 cd & 'iend=',iend(i,iint)
2182 do j=istart(i,iint),iend(i,iint)
2183 itypj=iabs(itype(j))
2184 if (itypj.eq.ntyp1) cycle
2188 rij=xj*xj+yj*yj+zj*zj
2189 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2190 r0ij=r0(itypi,itypj)
2192 c print *,i,j,r0ij,dsqrt(rij)
2193 if (rij.lt.r0ijsq) then
2194 evdwij=0.25d0*(rij-r0ijsq)**2
2202 C Calculate the components of the gradient in DC and X
2208 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2209 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2210 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2211 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2215 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2223 C--------------------------------------------------------------------------
2224 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2227 C Soft-sphere potential of p-p interaction
2229 implicit real*8 (a-h,o-z)
2230 include 'DIMENSIONS'
2231 include 'COMMON.CONTROL'
2232 include 'COMMON.IOUNITS'
2233 include 'COMMON.GEO'
2234 include 'COMMON.VAR'
2235 include 'COMMON.LOCAL'
2236 include 'COMMON.CHAIN'
2237 include 'COMMON.DERIV'
2238 include 'COMMON.INTERACT'
2239 include 'COMMON.CONTACTS'
2240 include 'COMMON.TORSION'
2241 include 'COMMON.VECTORS'
2242 include 'COMMON.FFIELD'
2244 C write(iout,*) 'In EELEC_soft_sphere'
2251 do i=iatel_s,iatel_e
2252 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2256 xmedi=c(1,i)+0.5d0*dxi
2257 ymedi=c(2,i)+0.5d0*dyi
2258 zmedi=c(3,i)+0.5d0*dzi
2259 xmedi=mod(xmedi,boxxsize)
2260 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2261 ymedi=mod(ymedi,boxysize)
2262 if (ymedi.lt.0) ymedi=ymedi+boxysize
2263 zmedi=mod(zmedi,boxzsize)
2264 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2266 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2267 do j=ielstart(i),ielend(i)
2268 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2272 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2273 r0ij=rpp(iteli,itelj)
2282 if (xj.lt.0) xj=xj+boxxsize
2284 if (yj.lt.0) yj=yj+boxysize
2286 if (zj.lt.0) zj=zj+boxzsize
2287 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2295 xj=xj_safe+xshift*boxxsize
2296 yj=yj_safe+yshift*boxysize
2297 zj=zj_safe+zshift*boxzsize
2298 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2299 if(dist_temp.lt.dist_init) then
2309 if (isubchap.eq.1) then
2318 rij=xj*xj+yj*yj+zj*zj
2319 sss=sscale(sqrt(rij))
2320 sssgrad=sscagrad(sqrt(rij))
2321 if (rij.lt.r0ijsq) then
2322 evdw1ij=0.25d0*(rij-r0ijsq)**2
2328 evdw1=evdw1+evdw1ij*sss
2330 C Calculate contributions to the Cartesian gradient.
2332 ggg(1)=fac*xj*sssgrad
2333 ggg(2)=fac*yj*sssgrad
2334 ggg(3)=fac*zj*sssgrad
2336 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2337 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2340 * Loop over residues i+1 thru j-1.
2344 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2349 cgrad do i=nnt,nct-1
2351 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2353 cgrad do j=i+1,nct-1
2355 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2361 c------------------------------------------------------------------------------
2362 subroutine vec_and_deriv
2363 implicit real*8 (a-h,o-z)
2364 include 'DIMENSIONS'
2368 include 'COMMON.IOUNITS'
2369 include 'COMMON.GEO'
2370 include 'COMMON.VAR'
2371 include 'COMMON.LOCAL'
2372 include 'COMMON.CHAIN'
2373 include 'COMMON.VECTORS'
2374 include 'COMMON.SETUP'
2375 include 'COMMON.TIME1'
2376 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2377 C Compute the local reference systems. For reference system (i), the
2378 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2379 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2381 do i=ivec_start,ivec_end
2385 if (i.eq.nres-1) then
2386 C Case of the last full residue
2387 C Compute the Z-axis
2388 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2389 costh=dcos(pi-theta(nres))
2390 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2394 C Compute the derivatives of uz
2396 uzder(2,1,1)=-dc_norm(3,i-1)
2397 uzder(3,1,1)= dc_norm(2,i-1)
2398 uzder(1,2,1)= dc_norm(3,i-1)
2400 uzder(3,2,1)=-dc_norm(1,i-1)
2401 uzder(1,3,1)=-dc_norm(2,i-1)
2402 uzder(2,3,1)= dc_norm(1,i-1)
2405 uzder(2,1,2)= dc_norm(3,i)
2406 uzder(3,1,2)=-dc_norm(2,i)
2407 uzder(1,2,2)=-dc_norm(3,i)
2409 uzder(3,2,2)= dc_norm(1,i)
2410 uzder(1,3,2)= dc_norm(2,i)
2411 uzder(2,3,2)=-dc_norm(1,i)
2413 C Compute the Y-axis
2416 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2418 C Compute the derivatives of uy
2421 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2422 & -dc_norm(k,i)*dc_norm(j,i-1)
2423 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2425 uyder(j,j,1)=uyder(j,j,1)-costh
2426 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2431 uygrad(l,k,j,i)=uyder(l,k,j)
2432 uzgrad(l,k,j,i)=uzder(l,k,j)
2436 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2437 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2438 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2439 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2442 C Compute the Z-axis
2443 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2444 costh=dcos(pi-theta(i+2))
2445 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2449 C Compute the derivatives of uz
2451 uzder(2,1,1)=-dc_norm(3,i+1)
2452 uzder(3,1,1)= dc_norm(2,i+1)
2453 uzder(1,2,1)= dc_norm(3,i+1)
2455 uzder(3,2,1)=-dc_norm(1,i+1)
2456 uzder(1,3,1)=-dc_norm(2,i+1)
2457 uzder(2,3,1)= dc_norm(1,i+1)
2460 uzder(2,1,2)= dc_norm(3,i)
2461 uzder(3,1,2)=-dc_norm(2,i)
2462 uzder(1,2,2)=-dc_norm(3,i)
2464 uzder(3,2,2)= dc_norm(1,i)
2465 uzder(1,3,2)= dc_norm(2,i)
2466 uzder(2,3,2)=-dc_norm(1,i)
2468 C Compute the Y-axis
2471 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2473 C Compute the derivatives of uy
2476 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2477 & -dc_norm(k,i)*dc_norm(j,i+1)
2478 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2480 uyder(j,j,1)=uyder(j,j,1)-costh
2481 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2486 uygrad(l,k,j,i)=uyder(l,k,j)
2487 uzgrad(l,k,j,i)=uzder(l,k,j)
2491 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2492 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2493 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2494 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2498 vbld_inv_temp(1)=vbld_inv(i+1)
2499 if (i.lt.nres-1) then
2500 vbld_inv_temp(2)=vbld_inv(i+2)
2502 vbld_inv_temp(2)=vbld_inv(i)
2507 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2508 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2513 #if defined(PARVEC) && defined(MPI)
2514 if (nfgtasks1.gt.1) then
2516 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2517 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2518 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2519 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2520 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2522 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2523 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2525 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2526 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2527 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2528 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2529 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2530 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2531 time_gather=time_gather+MPI_Wtime()-time00
2533 c if (fg_rank.eq.0) then
2534 c write (iout,*) "Arrays UY and UZ"
2536 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2543 C-----------------------------------------------------------------------------
2544 subroutine check_vecgrad
2545 implicit real*8 (a-h,o-z)
2546 include 'DIMENSIONS'
2547 include 'COMMON.IOUNITS'
2548 include 'COMMON.GEO'
2549 include 'COMMON.VAR'
2550 include 'COMMON.LOCAL'
2551 include 'COMMON.CHAIN'
2552 include 'COMMON.VECTORS'
2553 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2554 dimension uyt(3,maxres),uzt(3,maxres)
2555 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2556 double precision delta /1.0d-7/
2559 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2560 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2561 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2562 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2563 cd & (dc_norm(if90,i),if90=1,3)
2564 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2565 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2566 cd write(iout,'(a)')
2572 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2573 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2586 cd write (iout,*) 'i=',i
2588 erij(k)=dc_norm(k,i)
2592 dc_norm(k,i)=erij(k)
2594 dc_norm(j,i)=dc_norm(j,i)+delta
2595 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2597 c dc_norm(k,i)=dc_norm(k,i)/fac
2599 c write (iout,*) (dc_norm(k,i),k=1,3)
2600 c write (iout,*) (erij(k),k=1,3)
2603 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2604 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2605 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2606 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2608 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2609 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2610 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2613 dc_norm(k,i)=erij(k)
2616 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2617 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2618 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2619 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2620 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2621 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2622 cd write (iout,'(a)')
2627 C--------------------------------------------------------------------------
2628 subroutine set_matrices
2629 implicit real*8 (a-h,o-z)
2630 include 'DIMENSIONS'
2633 include "COMMON.SETUP"
2635 integer status(MPI_STATUS_SIZE)
2637 include 'COMMON.IOUNITS'
2638 include 'COMMON.GEO'
2639 include 'COMMON.VAR'
2640 include 'COMMON.LOCAL'
2641 include 'COMMON.CHAIN'
2642 include 'COMMON.DERIV'
2643 include 'COMMON.INTERACT'
2644 include 'COMMON.CONTACTS'
2645 include 'COMMON.TORSION'
2646 include 'COMMON.VECTORS'
2647 include 'COMMON.FFIELD'
2648 double precision auxvec(2),auxmat(2,2)
2650 C Compute the virtual-bond-torsional-angle dependent quantities needed
2651 C to calculate the el-loc multibody terms of various order.
2653 c write(iout,*) 'nphi=',nphi,nres
2655 do i=ivec_start+2,ivec_end+2
2660 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2661 iti = itortyp(itype(i-2))
2665 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2666 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2667 iti1 = itortyp(itype(i-1))
2672 b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0)
2673 & +bnew1(2,1,iti)*dsin(theta(i-1))
2674 & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0)
2675 gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2676 & +bnew1(2,1,iti)*dcos(theta(i-1))
2677 & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2678 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2679 c &*(cos(theta(i)/2.0)
2680 b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0)
2681 & +bnew2(2,1,iti)*dsin(theta(i-1))
2682 & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0)
2683 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2684 c &*(cos(theta(i)/2.0)
2685 gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2686 & +bnew2(2,1,iti)*dcos(theta(i-1))
2687 & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2688 c if (ggb1(1,i).eq.0.0d0) then
2689 c write(iout,*) 'i=',i,ggb1(1,i),
2690 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2691 c &bnew1(2,1,iti)*cos(theta(i)),
2692 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2694 b1(2,i-2)=bnew1(1,2,iti)
2696 b2(2,i-2)=bnew2(1,2,iti)
2698 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2699 EE(1,2,i-2)=eeold(1,2,iti)
2700 EE(2,1,i-2)=eeold(2,1,iti)
2701 EE(2,2,i-2)=eeold(2,2,iti)
2702 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2707 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2708 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2709 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2710 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2711 b1tilde(1,i-2)=b1(1,i-2)
2712 b1tilde(2,i-2)=-b1(2,i-2)
2713 b2tilde(1,i-2)=b2(1,i-2)
2714 b2tilde(2,i-2)=-b2(2,i-2)
2715 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2716 c write(iout,*) 'b1=',b1(1,i-2)
2717 c write (iout,*) 'theta=', theta(i-1)
2724 b1tilde(1,i-2)=b1(1,i-2)
2725 b1tilde(2,i-2)=-b1(2,i-2)
2726 b2tilde(1,i-2)=b2(1,i-2)
2727 b2tilde(2,i-2)=-b2(2,i-2)
2728 EE(1,2,i-2)=eeold(1,2,iti)
2729 EE(2,1,i-2)=eeold(2,1,iti)
2730 EE(2,2,i-2)=eeold(2,2,iti)
2731 EE(1,1,i-2)=eeold(1,1,iti)
2735 do i=ivec_start+2,ivec_end+2
2739 if (i .lt. nres+1) then
2776 if (i .gt. 3 .and. i .lt. nres+1) then
2777 obrot_der(1,i-2)=-sin1
2778 obrot_der(2,i-2)= cos1
2779 Ugder(1,1,i-2)= sin1
2780 Ugder(1,2,i-2)=-cos1
2781 Ugder(2,1,i-2)=-cos1
2782 Ugder(2,2,i-2)=-sin1
2785 obrot2_der(1,i-2)=-dwasin2
2786 obrot2_der(2,i-2)= dwacos2
2787 Ug2der(1,1,i-2)= dwasin2
2788 Ug2der(1,2,i-2)=-dwacos2
2789 Ug2der(2,1,i-2)=-dwacos2
2790 Ug2der(2,2,i-2)=-dwasin2
2792 obrot_der(1,i-2)=0.0d0
2793 obrot_der(2,i-2)=0.0d0
2794 Ugder(1,1,i-2)=0.0d0
2795 Ugder(1,2,i-2)=0.0d0
2796 Ugder(2,1,i-2)=0.0d0
2797 Ugder(2,2,i-2)=0.0d0
2798 obrot2_der(1,i-2)=0.0d0
2799 obrot2_der(2,i-2)=0.0d0
2800 Ug2der(1,1,i-2)=0.0d0
2801 Ug2der(1,2,i-2)=0.0d0
2802 Ug2der(2,1,i-2)=0.0d0
2803 Ug2der(2,2,i-2)=0.0d0
2805 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2806 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2807 iti = itortyp(itype(i-2))
2811 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2812 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2813 iti1 = itortyp(itype(i-1))
2817 cd write (iout,*) '*******i',i,' iti1',iti
2818 cd write (iout,*) 'b1',b1(:,iti)
2819 cd write (iout,*) 'b2',b2(:,iti)
2820 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2821 c if (i .gt. iatel_s+2) then
2822 if (i .gt. nnt+2) then
2823 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2825 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2826 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2828 c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
2829 c & EE(1,2,iti),EE(2,2,iti)
2830 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2831 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2832 c write(iout,*) "Macierz EUG",
2833 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2835 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2837 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2838 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2839 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2840 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2841 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2852 DtUg2(l,k,i-2)=0.0d0
2856 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2857 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2859 muder(k,i-2)=Ub2der(k,i-2)
2861 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2862 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2863 if (itype(i-1).le.ntyp) then
2864 iti1 = itortyp(itype(i-1))
2872 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2874 c write (iout,*) 'mu ',mu(:,i-2),i-2
2875 cd write (iout,*) 'mu1',mu1(:,i-2)
2876 cd write (iout,*) 'mu2',mu2(:,i-2)
2877 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2879 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2880 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2881 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2882 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2883 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2884 C Vectors and matrices dependent on a single virtual-bond dihedral.
2885 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
2886 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2887 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2888 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2889 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2890 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2891 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2892 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2893 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2896 C Matrices dependent on two consecutive virtual-bond dihedrals.
2897 C The order of matrices is from left to right.
2898 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2900 c do i=max0(ivec_start,2),ivec_end
2902 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2903 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2904 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2905 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2906 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2907 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2908 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2909 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2912 #if defined(MPI) && defined(PARMAT)
2914 c if (fg_rank.eq.0) then
2915 write (iout,*) "Arrays UG and UGDER before GATHER"
2917 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2918 & ((ug(l,k,i),l=1,2),k=1,2),
2919 & ((ugder(l,k,i),l=1,2),k=1,2)
2921 write (iout,*) "Arrays UG2 and UG2DER"
2923 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2924 & ((ug2(l,k,i),l=1,2),k=1,2),
2925 & ((ug2der(l,k,i),l=1,2),k=1,2)
2927 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2929 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2930 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2931 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2933 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2935 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2936 & costab(i),sintab(i),costab2(i),sintab2(i)
2938 write (iout,*) "Array MUDER"
2940 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2944 if (nfgtasks.gt.1) then
2946 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2947 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2948 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2950 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2951 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2953 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2954 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2956 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2957 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2959 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2960 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2962 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2963 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2965 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2966 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2968 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2969 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2970 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2971 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2972 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2973 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2974 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2975 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2976 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2977 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2978 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2979 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2980 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2982 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2983 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2985 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2986 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2988 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2989 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2991 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2992 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2994 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2995 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2997 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2998 & ivec_count(fg_rank1),
2999 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3001 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
3002 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3004 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
3005 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3007 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
3008 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3010 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
3011 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3013 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
3014 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3016 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
3017 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3019 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
3020 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3022 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
3023 & ivec_count(fg_rank1),
3024 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3026 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
3027 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3029 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
3030 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3032 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
3033 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3035 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
3036 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3038 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
3039 & ivec_count(fg_rank1),
3040 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3042 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
3043 & ivec_count(fg_rank1),
3044 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3046 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
3047 & ivec_count(fg_rank1),
3048 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3049 & MPI_MAT2,FG_COMM1,IERR)
3050 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
3051 & ivec_count(fg_rank1),
3052 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3053 & MPI_MAT2,FG_COMM1,IERR)
3056 c Passes matrix info through the ring
3059 if (irecv.lt.0) irecv=nfgtasks1-1
3062 if (inext.ge.nfgtasks1) inext=0
3064 c write (iout,*) "isend",isend," irecv",irecv
3066 lensend=lentyp(isend)
3067 lenrecv=lentyp(irecv)
3068 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
3069 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3070 c & MPI_ROTAT1(lensend),inext,2200+isend,
3071 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3072 c & iprev,2200+irecv,FG_COMM,status,IERR)
3073 c write (iout,*) "Gather ROTAT1"
3075 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3076 c & MPI_ROTAT2(lensend),inext,3300+isend,
3077 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3078 c & iprev,3300+irecv,FG_COMM,status,IERR)
3079 c write (iout,*) "Gather ROTAT2"
3081 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
3082 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
3083 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
3084 & iprev,4400+irecv,FG_COMM,status,IERR)
3085 c write (iout,*) "Gather ROTAT_OLD"
3087 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
3088 & MPI_PRECOMP11(lensend),inext,5500+isend,
3089 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
3090 & iprev,5500+irecv,FG_COMM,status,IERR)
3091 c write (iout,*) "Gather PRECOMP11"
3093 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
3094 & MPI_PRECOMP12(lensend),inext,6600+isend,
3095 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
3096 & iprev,6600+irecv,FG_COMM,status,IERR)
3097 c write (iout,*) "Gather PRECOMP12"
3099 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3101 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
3102 & MPI_ROTAT2(lensend),inext,7700+isend,
3103 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3104 & iprev,7700+irecv,FG_COMM,status,IERR)
3105 c write (iout,*) "Gather PRECOMP21"
3107 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
3108 & MPI_PRECOMP22(lensend),inext,8800+isend,
3109 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
3110 & iprev,8800+irecv,FG_COMM,status,IERR)
3111 c write (iout,*) "Gather PRECOMP22"
3113 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
3114 & MPI_PRECOMP23(lensend),inext,9900+isend,
3115 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
3116 & MPI_PRECOMP23(lenrecv),
3117 & iprev,9900+irecv,FG_COMM,status,IERR)
3118 c write (iout,*) "Gather PRECOMP23"
3123 if (irecv.lt.0) irecv=nfgtasks1-1
3126 time_gather=time_gather+MPI_Wtime()-time00
3129 c if (fg_rank.eq.0) then
3130 write (iout,*) "Arrays UG and UGDER"
3132 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3133 & ((ug(l,k,i),l=1,2),k=1,2),
3134 & ((ugder(l,k,i),l=1,2),k=1,2)
3136 write (iout,*) "Arrays UG2 and UG2DER"
3138 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3139 & ((ug2(l,k,i),l=1,2),k=1,2),
3140 & ((ug2der(l,k,i),l=1,2),k=1,2)
3142 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3144 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3145 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3146 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3148 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3150 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3151 & costab(i),sintab(i),costab2(i),sintab2(i)
3153 write (iout,*) "Array MUDER"
3155 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3161 cd iti = itortyp(itype(i))
3164 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3165 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3170 C--------------------------------------------------------------------------
3171 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3173 C This subroutine calculates the average interaction energy and its gradient
3174 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3175 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3176 C The potential depends both on the distance of peptide-group centers and on
3177 C the orientation of the CA-CA virtual bonds.
3179 implicit real*8 (a-h,o-z)
3183 include 'DIMENSIONS'
3184 include 'COMMON.CONTROL'
3185 include 'COMMON.SETUP'
3186 include 'COMMON.IOUNITS'
3187 include 'COMMON.GEO'
3188 include 'COMMON.VAR'
3189 include 'COMMON.LOCAL'
3190 include 'COMMON.CHAIN'
3191 include 'COMMON.DERIV'
3192 include 'COMMON.INTERACT'
3193 include 'COMMON.CONTACTS'
3194 include 'COMMON.TORSION'
3195 include 'COMMON.VECTORS'
3196 include 'COMMON.FFIELD'
3197 include 'COMMON.TIME1'
3198 include 'COMMON.SPLITELE'
3199 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3200 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3201 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3202 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3203 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3204 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3206 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3208 double precision scal_el /1.0d0/
3210 double precision scal_el /0.5d0/
3213 C 13-go grudnia roku pamietnego...
3214 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3215 & 0.0d0,1.0d0,0.0d0,
3216 & 0.0d0,0.0d0,1.0d0/
3217 cd write(iout,*) 'In EELEC'
3219 cd write(iout,*) 'Type',i
3220 cd write(iout,*) 'B1',B1(:,i)
3221 cd write(iout,*) 'B2',B2(:,i)
3222 cd write(iout,*) 'CC',CC(:,:,i)
3223 cd write(iout,*) 'DD',DD(:,:,i)
3224 cd write(iout,*) 'EE',EE(:,:,i)
3226 cd call check_vecgrad
3228 if (icheckgrad.eq.1) then
3230 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3232 dc_norm(k,i)=dc(k,i)*fac
3234 c write (iout,*) 'i',i,' fac',fac
3237 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3238 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3239 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3240 c call vec_and_deriv
3246 time_mat=time_mat+MPI_Wtime()-time01
3250 cd write (iout,*) 'i=',i
3252 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3255 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3256 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3269 cd print '(a)','Enter EELEC'
3270 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3272 gel_loc_loc(i)=0.0d0
3277 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3279 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3281 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3282 do i=iturn3_start,iturn3_end
3284 C write(iout,*) "tu jest i",i
3285 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3286 & .or. itype(i+2).eq.ntyp1
3287 & .or. itype(i+3).eq.ntyp1
3288 & .or. itype(i-1).eq.ntyp1
3289 & .or. itype(i+4).eq.ntyp1
3294 dx_normi=dc_norm(1,i)
3295 dy_normi=dc_norm(2,i)
3296 dz_normi=dc_norm(3,i)
3297 xmedi=c(1,i)+0.5d0*dxi
3298 ymedi=c(2,i)+0.5d0*dyi
3299 zmedi=c(3,i)+0.5d0*dzi
3300 xmedi=mod(xmedi,boxxsize)
3301 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3302 ymedi=mod(ymedi,boxysize)
3303 if (ymedi.lt.0) ymedi=ymedi+boxysize
3304 zmedi=mod(zmedi,boxzsize)
3305 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3307 call eelecij(i,i+2,ees,evdw1,eel_loc)
3308 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3309 num_cont_hb(i)=num_conti
3311 do i=iturn4_start,iturn4_end
3313 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3314 & .or. itype(i+3).eq.ntyp1
3315 & .or. itype(i+4).eq.ntyp1
3316 & .or. itype(i+5).eq.ntyp1
3317 & .or. itype(i).eq.ntyp1
3318 & .or. itype(i-1).eq.ntyp1
3323 dx_normi=dc_norm(1,i)
3324 dy_normi=dc_norm(2,i)
3325 dz_normi=dc_norm(3,i)
3326 xmedi=c(1,i)+0.5d0*dxi
3327 ymedi=c(2,i)+0.5d0*dyi
3328 zmedi=c(3,i)+0.5d0*dzi
3329 C Return atom into box, boxxsize is size of box in x dimension
3331 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3332 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3333 C Condition for being inside the proper box
3334 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3335 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3339 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3340 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3341 C Condition for being inside the proper box
3342 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3343 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3347 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3348 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3349 C Condition for being inside the proper box
3350 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3351 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3354 xmedi=mod(xmedi,boxxsize)
3355 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3356 ymedi=mod(ymedi,boxysize)
3357 if (ymedi.lt.0) ymedi=ymedi+boxysize
3358 zmedi=mod(zmedi,boxzsize)
3359 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3361 num_conti=num_cont_hb(i)
3362 c write(iout,*) "JESTEM W PETLI"
3363 call eelecij(i,i+3,ees,evdw1,eel_loc)
3364 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3365 & call eturn4(i,eello_turn4)
3366 num_cont_hb(i)=num_conti
3368 C Loop over all neighbouring boxes
3373 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3375 do i=iatel_s,iatel_e
3377 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3378 & .or. itype(i+2).eq.ntyp1
3379 & .or. itype(i-1).eq.ntyp1
3384 dx_normi=dc_norm(1,i)
3385 dy_normi=dc_norm(2,i)
3386 dz_normi=dc_norm(3,i)
3387 xmedi=c(1,i)+0.5d0*dxi
3388 ymedi=c(2,i)+0.5d0*dyi
3389 zmedi=c(3,i)+0.5d0*dzi
3390 xmedi=mod(xmedi,boxxsize)
3391 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3392 ymedi=mod(ymedi,boxysize)
3393 if (ymedi.lt.0) ymedi=ymedi+boxysize
3394 zmedi=mod(zmedi,boxzsize)
3395 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3396 C xmedi=xmedi+xshift*boxxsize
3397 C ymedi=ymedi+yshift*boxysize
3398 C zmedi=zmedi+zshift*boxzsize
3400 C Return tom into box, boxxsize is size of box in x dimension
3402 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3403 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3404 C Condition for being inside the proper box
3405 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3406 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3410 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3411 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3412 C Condition for being inside the proper box
3413 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3414 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3418 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3419 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3420 cC Condition for being inside the proper box
3421 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3422 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3426 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3427 num_conti=num_cont_hb(i)
3428 do j=ielstart(i),ielend(i)
3429 C write (iout,*) i,j
3431 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3432 & .or.itype(j+2).eq.ntyp1
3433 & .or.itype(j-1).eq.ntyp1
3435 call eelecij(i,j,ees,evdw1,eel_loc)
3437 num_cont_hb(i)=num_conti
3443 c write (iout,*) "Number of loop steps in EELEC:",ind
3445 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3446 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3448 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3449 ccc eel_loc=eel_loc+eello_turn3
3450 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3453 C-------------------------------------------------------------------------------
3454 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3455 implicit real*8 (a-h,o-z)
3456 include 'DIMENSIONS'
3460 include 'COMMON.CONTROL'
3461 include 'COMMON.IOUNITS'
3462 include 'COMMON.GEO'
3463 include 'COMMON.VAR'
3464 include 'COMMON.LOCAL'
3465 include 'COMMON.CHAIN'
3466 include 'COMMON.DERIV'
3467 include 'COMMON.INTERACT'
3468 include 'COMMON.CONTACTS'
3469 include 'COMMON.TORSION'
3470 include 'COMMON.VECTORS'
3471 include 'COMMON.FFIELD'
3472 include 'COMMON.TIME1'
3473 include 'COMMON.SPLITELE'
3474 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3475 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3476 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3477 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3478 & gmuij2(4),gmuji2(4)
3479 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3480 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3482 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3484 double precision scal_el /1.0d0/
3486 double precision scal_el /0.5d0/
3489 C 13-go grudnia roku pamietnego...
3490 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3491 & 0.0d0,1.0d0,0.0d0,
3492 & 0.0d0,0.0d0,1.0d0/
3493 c time00=MPI_Wtime()
3494 cd write (iout,*) "eelecij",i,j
3498 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3499 aaa=app(iteli,itelj)
3500 bbb=bpp(iteli,itelj)
3501 ael6i=ael6(iteli,itelj)
3502 ael3i=ael3(iteli,itelj)
3506 dx_normj=dc_norm(1,j)
3507 dy_normj=dc_norm(2,j)
3508 dz_normj=dc_norm(3,j)
3509 C xj=c(1,j)+0.5D0*dxj-xmedi
3510 C yj=c(2,j)+0.5D0*dyj-ymedi
3511 C zj=c(3,j)+0.5D0*dzj-zmedi
3516 if (xj.lt.0) xj=xj+boxxsize
3518 if (yj.lt.0) yj=yj+boxysize
3520 if (zj.lt.0) zj=zj+boxzsize
3521 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3522 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3530 xj=xj_safe+xshift*boxxsize
3531 yj=yj_safe+yshift*boxysize
3532 zj=zj_safe+zshift*boxzsize
3533 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3534 if(dist_temp.lt.dist_init) then
3544 if (isubchap.eq.1) then
3553 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3555 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3556 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3557 C Condition for being inside the proper box
3558 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3559 c & (xj.lt.((-0.5d0)*boxxsize))) then
3563 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3564 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3565 C Condition for being inside the proper box
3566 c if ((yj.gt.((0.5d0)*boxysize)).or.
3567 c & (yj.lt.((-0.5d0)*boxysize))) then
3571 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3572 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3573 C Condition for being inside the proper box
3574 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3575 c & (zj.lt.((-0.5d0)*boxzsize))) then
3578 C endif !endPBC condintion
3582 rij=xj*xj+yj*yj+zj*zj
3584 sss=sscale(sqrt(rij))
3585 sssgrad=sscagrad(sqrt(rij))
3586 c if (sss.gt.0.0d0) then
3592 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3593 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3594 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3595 fac=cosa-3.0D0*cosb*cosg
3597 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3598 if (j.eq.i+2) ev1=scal_el*ev1
3603 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3607 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3608 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3610 evdw1=evdw1+evdwij*sss
3611 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3612 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3613 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3614 cd & xmedi,ymedi,zmedi,xj,yj,zj
3616 if (energy_dec) then
3617 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3619 &,iteli,itelj,aaa,evdw1
3620 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3624 C Calculate contributions to the Cartesian gradient.
3627 facvdw=-6*rrmij*(ev1+evdwij)*sss
3628 facel=-3*rrmij*(el1+eesij)
3634 * Radial derivatives. First process both termini of the fragment (i,j)
3640 c ghalf=0.5D0*ggg(k)
3641 c gelc(k,i)=gelc(k,i)+ghalf
3642 c gelc(k,j)=gelc(k,j)+ghalf
3644 c 9/28/08 AL Gradient compotents will be summed only at the end
3646 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3647 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3650 * Loop over residues i+1 thru j-1.
3654 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3657 if (sss.gt.0.0) then
3658 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3659 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3660 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3667 c ghalf=0.5D0*ggg(k)
3668 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3669 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3671 c 9/28/08 AL Gradient compotents will be summed only at the end
3673 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3674 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3677 * Loop over residues i+1 thru j-1.
3681 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3686 facvdw=(ev1+evdwij)*sss
3689 fac=-3*rrmij*(facvdw+facvdw+facel)
3694 * Radial derivatives. First process both termini of the fragment (i,j)
3700 c ghalf=0.5D0*ggg(k)
3701 c gelc(k,i)=gelc(k,i)+ghalf
3702 c gelc(k,j)=gelc(k,j)+ghalf
3704 c 9/28/08 AL Gradient compotents will be summed only at the end
3706 gelc_long(k,j)=gelc(k,j)+ggg(k)
3707 gelc_long(k,i)=gelc(k,i)-ggg(k)
3710 * Loop over residues i+1 thru j-1.
3714 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3717 c 9/28/08 AL Gradient compotents will be summed only at the end
3718 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3719 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3720 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3722 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3723 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3729 ecosa=2.0D0*fac3*fac1+fac4
3732 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3733 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3735 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3736 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3738 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3739 cd & (dcosg(k),k=1,3)
3741 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3744 c ghalf=0.5D0*ggg(k)
3745 c gelc(k,i)=gelc(k,i)+ghalf
3746 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3747 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3748 c gelc(k,j)=gelc(k,j)+ghalf
3749 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3750 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3754 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3759 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3760 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3762 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3763 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3764 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3765 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3769 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3770 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3771 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3773 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3774 C energy of a peptide unit is assumed in the form of a second-order
3775 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3776 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3777 C are computed for EVERY pair of non-contiguous peptide groups.
3780 if (j.lt.nres-1) then
3792 muij(kkk)=mu(k,i)*mu(l,j)
3793 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
3795 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
3796 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
3797 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
3798 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
3799 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
3800 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
3804 cd write (iout,*) 'EELEC: i',i,' j',j
3805 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3806 cd write(iout,*) 'muij',muij
3807 ury=scalar(uy(1,i),erij)
3808 urz=scalar(uz(1,i),erij)
3809 vry=scalar(uy(1,j),erij)
3810 vrz=scalar(uz(1,j),erij)
3811 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3812 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3813 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3814 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3815 fac=dsqrt(-ael6i)*r3ij
3820 cd write (iout,'(4i5,4f10.5)')
3821 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3822 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3823 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3824 cd & uy(:,j),uz(:,j)
3825 cd write (iout,'(4f10.5)')
3826 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3827 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3828 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3829 cd write (iout,'(9f10.5/)')
3830 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3831 C Derivatives of the elements of A in virtual-bond vectors
3832 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3834 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3835 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3836 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3837 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3838 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3839 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3840 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3841 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3842 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3843 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3844 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3845 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3847 C Compute radial contributions to the gradient
3865 C Add the contributions coming from er
3868 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3869 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3870 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3871 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3874 C Derivatives in DC(i)
3875 cgrad ghalf1=0.5d0*agg(k,1)
3876 cgrad ghalf2=0.5d0*agg(k,2)
3877 cgrad ghalf3=0.5d0*agg(k,3)
3878 cgrad ghalf4=0.5d0*agg(k,4)
3879 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3880 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3881 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3882 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3883 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3884 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3885 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3886 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3887 C Derivatives in DC(i+1)
3888 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3889 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3890 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3891 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3892 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3893 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3894 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3895 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3896 C Derivatives in DC(j)
3897 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3898 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3899 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3900 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3901 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3902 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3903 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3904 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3905 C Derivatives in DC(j+1) or DC(nres-1)
3906 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3907 & -3.0d0*vryg(k,3)*ury)
3908 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3909 & -3.0d0*vrzg(k,3)*ury)
3910 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3911 & -3.0d0*vryg(k,3)*urz)
3912 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3913 & -3.0d0*vrzg(k,3)*urz)
3914 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3916 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3929 aggi(k,l)=-aggi(k,l)
3930 aggi1(k,l)=-aggi1(k,l)
3931 aggj(k,l)=-aggj(k,l)
3932 aggj1(k,l)=-aggj1(k,l)
3935 if (j.lt.nres-1) then
3941 aggi(k,l)=-aggi(k,l)
3942 aggi1(k,l)=-aggi1(k,l)
3943 aggj(k,l)=-aggj(k,l)
3944 aggj1(k,l)=-aggj1(k,l)
3955 aggi(k,l)=-aggi(k,l)
3956 aggi1(k,l)=-aggi1(k,l)
3957 aggj(k,l)=-aggj(k,l)
3958 aggj1(k,l)=-aggj1(k,l)
3963 IF (wel_loc.gt.0.0d0) THEN
3964 C Contribution to the local-electrostatic energy coming from the i-j pair
3965 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3967 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3968 c & ' eel_loc_ij',eel_loc_ij
3969 c write(iout,*) 'muije=',muij(1),muij(2),muij(3),muij(4)
3970 C Calculate patrial derivative for theta angle
3972 geel_loc_ij=a22*gmuij1(1)
3976 c write(iout,*) "derivative over thatai"
3977 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3979 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3980 & geel_loc_ij*wel_loc
3981 c write(iout,*) "derivative over thatai-1"
3982 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3989 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3990 & geel_loc_ij*wel_loc
3991 c Derivative over j residue
3992 geel_loc_ji=a22*gmuji1(1)
3996 c write(iout,*) "derivative over thataj"
3997 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4000 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4001 & geel_loc_ji*wel_loc
4007 c write(iout,*) "derivative over thataj-1"
4008 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4010 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4011 & geel_loc_ji*wel_loc
4013 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4015 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4016 & 'eelloc',i,j,eel_loc_ij
4017 c if (eel_loc_ij.ne.0)
4018 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4019 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4021 eel_loc=eel_loc+eel_loc_ij
4022 C Partial derivatives in virtual-bond dihedral angles gamma
4024 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4025 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4026 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
4027 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4028 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4029 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
4030 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4032 ggg(l)=agg(l,1)*muij(1)+
4033 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
4034 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4035 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4036 cgrad ghalf=0.5d0*ggg(l)
4037 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4038 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4042 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4045 C Remaining derivatives of eello
4047 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4048 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4049 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4050 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4051 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4052 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4053 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4054 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4057 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4058 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4059 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4060 & .and. num_conti.le.maxconts) then
4061 c write (iout,*) i,j," entered corr"
4063 C Calculate the contact function. The ith column of the array JCONT will
4064 C contain the numbers of atoms that make contacts with the atom I (of numbers
4065 C greater than I). The arrays FACONT and GACONT will contain the values of
4066 C the contact function and its derivative.
4067 c r0ij=1.02D0*rpp(iteli,itelj)
4068 c r0ij=1.11D0*rpp(iteli,itelj)
4069 r0ij=2.20D0*rpp(iteli,itelj)
4070 c r0ij=1.55D0*rpp(iteli,itelj)
4071 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4072 if (fcont.gt.0.0D0) then
4073 num_conti=num_conti+1
4074 if (num_conti.gt.maxconts) then
4075 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4076 & ' will skip next contacts for this conf.'
4078 jcont_hb(num_conti,i)=j
4079 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4080 cd & " jcont_hb",jcont_hb(num_conti,i)
4081 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4082 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4083 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4085 d_cont(num_conti,i)=rij
4086 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4087 C --- Electrostatic-interaction matrix ---
4088 a_chuj(1,1,num_conti,i)=a22
4089 a_chuj(1,2,num_conti,i)=a23
4090 a_chuj(2,1,num_conti,i)=a32
4091 a_chuj(2,2,num_conti,i)=a33
4092 C --- Gradient of rij
4094 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4101 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4102 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4103 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4104 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4105 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4110 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4111 C Calculate contact energies
4113 wij=cosa-3.0D0*cosb*cosg
4116 c fac3=dsqrt(-ael6i)/r0ij**3
4117 fac3=dsqrt(-ael6i)*r3ij
4118 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4119 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4120 if (ees0tmp.gt.0) then
4121 ees0pij=dsqrt(ees0tmp)
4125 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4126 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4127 if (ees0tmp.gt.0) then
4128 ees0mij=dsqrt(ees0tmp)
4133 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4134 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4135 C Diagnostics. Comment out or remove after debugging!
4136 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4137 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4138 c ees0m(num_conti,i)=0.0D0
4140 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4141 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4142 C Angular derivatives of the contact function
4143 ees0pij1=fac3/ees0pij
4144 ees0mij1=fac3/ees0mij
4145 fac3p=-3.0D0*fac3*rrmij
4146 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4147 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4149 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4150 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4151 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4152 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4153 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4154 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4155 ecosap=ecosa1+ecosa2
4156 ecosbp=ecosb1+ecosb2
4157 ecosgp=ecosg1+ecosg2
4158 ecosam=ecosa1-ecosa2
4159 ecosbm=ecosb1-ecosb2
4160 ecosgm=ecosg1-ecosg2
4169 facont_hb(num_conti,i)=fcont
4170 fprimcont=fprimcont/rij
4171 cd facont_hb(num_conti,i)=1.0D0
4172 C Following line is for diagnostics.
4175 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4176 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4179 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4180 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4182 gggp(1)=gggp(1)+ees0pijp*xj
4183 gggp(2)=gggp(2)+ees0pijp*yj
4184 gggp(3)=gggp(3)+ees0pijp*zj
4185 gggm(1)=gggm(1)+ees0mijp*xj
4186 gggm(2)=gggm(2)+ees0mijp*yj
4187 gggm(3)=gggm(3)+ees0mijp*zj
4188 C Derivatives due to the contact function
4189 gacont_hbr(1,num_conti,i)=fprimcont*xj
4190 gacont_hbr(2,num_conti,i)=fprimcont*yj
4191 gacont_hbr(3,num_conti,i)=fprimcont*zj
4194 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4195 c following the change of gradient-summation algorithm.
4197 cgrad ghalfp=0.5D0*gggp(k)
4198 cgrad ghalfm=0.5D0*gggm(k)
4199 gacontp_hb1(k,num_conti,i)=!ghalfp
4200 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4201 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4202 gacontp_hb2(k,num_conti,i)=!ghalfp
4203 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4204 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4205 gacontp_hb3(k,num_conti,i)=gggp(k)
4206 gacontm_hb1(k,num_conti,i)=!ghalfm
4207 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4208 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4209 gacontm_hb2(k,num_conti,i)=!ghalfm
4210 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4211 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4212 gacontm_hb3(k,num_conti,i)=gggm(k)
4214 C Diagnostics. Comment out or remove after debugging!
4216 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4217 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4218 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4219 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4220 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4221 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4224 endif ! num_conti.le.maxconts
4227 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4230 ghalf=0.5d0*agg(l,k)
4231 aggi(l,k)=aggi(l,k)+ghalf
4232 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4233 aggj(l,k)=aggj(l,k)+ghalf
4236 if (j.eq.nres-1 .and. i.lt.j-2) then
4239 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4244 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4247 C-----------------------------------------------------------------------------
4248 subroutine eturn3(i,eello_turn3)
4249 C Third- and fourth-order contributions from turns
4250 implicit real*8 (a-h,o-z)
4251 include 'DIMENSIONS'
4252 include 'COMMON.IOUNITS'
4253 include 'COMMON.GEO'
4254 include 'COMMON.VAR'
4255 include 'COMMON.LOCAL'
4256 include 'COMMON.CHAIN'
4257 include 'COMMON.DERIV'
4258 include 'COMMON.INTERACT'
4259 include 'COMMON.CONTACTS'
4260 include 'COMMON.TORSION'
4261 include 'COMMON.VECTORS'
4262 include 'COMMON.FFIELD'
4263 include 'COMMON.CONTROL'
4265 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4266 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4267 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4268 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4269 & auxgmat2(2,2),auxgmatt2(2,2)
4270 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4271 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4272 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4273 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4276 c write (iout,*) "eturn3",i,j,j1,j2
4281 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4283 C Third-order contributions
4290 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4291 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4292 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4293 c auxalary matices for theta gradient
4294 c auxalary matrix for i+1 and constant i+2
4295 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4296 c auxalary matrix for i+2 and constant i+1
4297 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4298 call transpose2(auxmat(1,1),auxmat1(1,1))
4299 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4300 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4301 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4302 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4303 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4304 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4305 C Derivatives in theta
4306 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4307 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4308 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4309 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4311 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4312 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4313 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4314 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4315 cd & ' eello_turn3_num',4*eello_turn3_num
4316 C Derivatives in gamma(i)
4317 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4318 call transpose2(auxmat2(1,1),auxmat3(1,1))
4319 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4320 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4321 C Derivatives in gamma(i+1)
4322 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4323 call transpose2(auxmat2(1,1),auxmat3(1,1))
4324 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4325 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4326 & +0.5d0*(pizda(1,1)+pizda(2,2))
4327 C Cartesian derivatives
4329 c ghalf1=0.5d0*agg(l,1)
4330 c ghalf2=0.5d0*agg(l,2)
4331 c ghalf3=0.5d0*agg(l,3)
4332 c ghalf4=0.5d0*agg(l,4)
4333 a_temp(1,1)=aggi(l,1)!+ghalf1
4334 a_temp(1,2)=aggi(l,2)!+ghalf2
4335 a_temp(2,1)=aggi(l,3)!+ghalf3
4336 a_temp(2,2)=aggi(l,4)!+ghalf4
4337 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4338 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4339 & +0.5d0*(pizda(1,1)+pizda(2,2))
4340 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4341 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4342 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4343 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4344 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4345 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4346 & +0.5d0*(pizda(1,1)+pizda(2,2))
4347 a_temp(1,1)=aggj(l,1)!+ghalf1
4348 a_temp(1,2)=aggj(l,2)!+ghalf2
4349 a_temp(2,1)=aggj(l,3)!+ghalf3
4350 a_temp(2,2)=aggj(l,4)!+ghalf4
4351 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4352 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4353 & +0.5d0*(pizda(1,1)+pizda(2,2))
4354 a_temp(1,1)=aggj1(l,1)
4355 a_temp(1,2)=aggj1(l,2)
4356 a_temp(2,1)=aggj1(l,3)
4357 a_temp(2,2)=aggj1(l,4)
4358 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4359 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4360 & +0.5d0*(pizda(1,1)+pizda(2,2))
4364 C-------------------------------------------------------------------------------
4365 subroutine eturn4(i,eello_turn4)
4366 C Third- and fourth-order contributions from turns
4367 implicit real*8 (a-h,o-z)
4368 include 'DIMENSIONS'
4369 include 'COMMON.IOUNITS'
4370 include 'COMMON.GEO'
4371 include 'COMMON.VAR'
4372 include 'COMMON.LOCAL'
4373 include 'COMMON.CHAIN'
4374 include 'COMMON.DERIV'
4375 include 'COMMON.INTERACT'
4376 include 'COMMON.CONTACTS'
4377 include 'COMMON.TORSION'
4378 include 'COMMON.VECTORS'
4379 include 'COMMON.FFIELD'
4380 include 'COMMON.CONTROL'
4382 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4383 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4384 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4385 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4386 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4387 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4388 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4389 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4390 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4391 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4392 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4395 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4397 C Fourth-order contributions
4405 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4406 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4407 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4408 c write(iout,*)"WCHODZE W PROGRAM"
4413 iti1=itortyp(itype(i+1))
4414 iti2=itortyp(itype(i+2))
4415 iti3=itortyp(itype(i+3))
4416 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4417 call transpose2(EUg(1,1,i+1),e1t(1,1))
4418 call transpose2(Eug(1,1,i+2),e2t(1,1))
4419 call transpose2(Eug(1,1,i+3),e3t(1,1))
4420 C Ematrix derivative in theta
4421 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4422 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4423 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4424 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4425 c eta1 in derivative theta
4426 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4427 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4428 c auxgvec is derivative of Ub2 so i+3 theta
4429 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4430 c auxalary matrix of E i+1
4431 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4434 s1=scalar2(b1(1,i+2),auxvec(1))
4435 c derivative of theta i+2 with constant i+3
4436 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4437 c derivative of theta i+2 with constant i+2
4438 gs32=scalar2(b1(1,i+2),auxgvec(1))
4439 c derivative of E matix in theta of i+1
4440 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4442 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4443 c ea31 in derivative theta
4444 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4445 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4446 c auxilary matrix auxgvec of Ub2 with constant E matirx
4447 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4448 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4449 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4453 s2=scalar2(b1(1,i+1),auxvec(1))
4454 c derivative of theta i+1 with constant i+3
4455 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4456 c derivative of theta i+2 with constant i+1
4457 gs21=scalar2(b1(1,i+1),auxgvec(1))
4458 c derivative of theta i+3 with constant i+1
4459 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4460 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4462 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4463 c two derivatives over diffetent matrices
4464 c gtae3e2 is derivative over i+3
4465 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4466 c ae3gte2 is derivative over i+2
4467 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4468 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4469 c three possible derivative over theta E matices
4471 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4473 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4475 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4476 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4478 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4479 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4480 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4482 eello_turn4=eello_turn4-(s1+s2+s3)
4483 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4484 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4485 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4486 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4487 cd & ' eello_turn4_num',8*eello_turn4_num
4489 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4490 & -(gs13+gsE13+gsEE1)*wturn4
4491 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
4492 & -(gs23+gs21+gsEE2)*wturn4
4493 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
4494 & -(gs32+gsE31+gsEE3)*wturn4
4495 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
4498 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4499 & 'eturn4',i,j,-(s1+s2+s3)
4500 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4501 c & ' eello_turn4_num',8*eello_turn4_num
4502 C Derivatives in gamma(i)
4503 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4504 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4505 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4506 s1=scalar2(b1(1,i+2),auxvec(1))
4507 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4508 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4509 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4510 C Derivatives in gamma(i+1)
4511 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4512 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4513 s2=scalar2(b1(1,i+1),auxvec(1))
4514 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4515 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4516 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4517 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4518 C Derivatives in gamma(i+2)
4519 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4520 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4521 s1=scalar2(b1(1,i+2),auxvec(1))
4522 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4523 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4524 s2=scalar2(b1(1,i+1),auxvec(1))
4525 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4526 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4527 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4528 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4529 C Cartesian derivatives
4530 C Derivatives of this turn contributions in DC(i+2)
4531 if (j.lt.nres-1) then
4533 a_temp(1,1)=agg(l,1)
4534 a_temp(1,2)=agg(l,2)
4535 a_temp(2,1)=agg(l,3)
4536 a_temp(2,2)=agg(l,4)
4537 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4538 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4539 s1=scalar2(b1(1,i+2),auxvec(1))
4540 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4541 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4542 s2=scalar2(b1(1,i+1),auxvec(1))
4543 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4544 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4545 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4547 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4550 C Remaining derivatives of this turn contribution
4552 a_temp(1,1)=aggi(l,1)
4553 a_temp(1,2)=aggi(l,2)
4554 a_temp(2,1)=aggi(l,3)
4555 a_temp(2,2)=aggi(l,4)
4556 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4557 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4558 s1=scalar2(b1(1,i+2),auxvec(1))
4559 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4560 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4561 s2=scalar2(b1(1,i+1),auxvec(1))
4562 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4563 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4564 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4565 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4566 a_temp(1,1)=aggi1(l,1)
4567 a_temp(1,2)=aggi1(l,2)
4568 a_temp(2,1)=aggi1(l,3)
4569 a_temp(2,2)=aggi1(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))
4579 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4580 a_temp(1,1)=aggj(l,1)
4581 a_temp(1,2)=aggj(l,2)
4582 a_temp(2,1)=aggj(l,3)
4583 a_temp(2,2)=aggj(l,4)
4584 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4585 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4586 s1=scalar2(b1(1,i+2),auxvec(1))
4587 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4588 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4589 s2=scalar2(b1(1,i+1),auxvec(1))
4590 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4591 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4592 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4593 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4594 a_temp(1,1)=aggj1(l,1)
4595 a_temp(1,2)=aggj1(l,2)
4596 a_temp(2,1)=aggj1(l,3)
4597 a_temp(2,2)=aggj1(l,4)
4598 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4599 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4600 s1=scalar2(b1(1,i+2),auxvec(1))
4601 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4602 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4603 s2=scalar2(b1(1,i+1),auxvec(1))
4604 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4605 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4606 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4607 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4608 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4612 C-----------------------------------------------------------------------------
4613 subroutine vecpr(u,v,w)
4614 implicit real*8(a-h,o-z)
4615 dimension u(3),v(3),w(3)
4616 w(1)=u(2)*v(3)-u(3)*v(2)
4617 w(2)=-u(1)*v(3)+u(3)*v(1)
4618 w(3)=u(1)*v(2)-u(2)*v(1)
4621 C-----------------------------------------------------------------------------
4622 subroutine unormderiv(u,ugrad,unorm,ungrad)
4623 C This subroutine computes the derivatives of a normalized vector u, given
4624 C the derivatives computed without normalization conditions, ugrad. Returns
4627 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4628 double precision vec(3)
4629 double precision scalar
4631 c write (2,*) 'ugrad',ugrad
4634 vec(i)=scalar(ugrad(1,i),u(1))
4636 c write (2,*) 'vec',vec
4639 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4642 c write (2,*) 'ungrad',ungrad
4645 C-----------------------------------------------------------------------------
4646 subroutine escp_soft_sphere(evdw2,evdw2_14)
4648 C This subroutine calculates the excluded-volume interaction energy between
4649 C peptide-group centers and side chains and its gradient in virtual-bond and
4650 C side-chain vectors.
4652 implicit real*8 (a-h,o-z)
4653 include 'DIMENSIONS'
4654 include 'COMMON.GEO'
4655 include 'COMMON.VAR'
4656 include 'COMMON.LOCAL'
4657 include 'COMMON.CHAIN'
4658 include 'COMMON.DERIV'
4659 include 'COMMON.INTERACT'
4660 include 'COMMON.FFIELD'
4661 include 'COMMON.IOUNITS'
4662 include 'COMMON.CONTROL'
4667 cd print '(a)','Enter ESCP'
4668 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4672 do i=iatscp_s,iatscp_e
4673 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4675 xi=0.5D0*(c(1,i)+c(1,i+1))
4676 yi=0.5D0*(c(2,i)+c(2,i+1))
4677 zi=0.5D0*(c(3,i)+c(3,i+1))
4678 C Return atom into box, boxxsize is size of box in x dimension
4680 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4681 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4682 C Condition for being inside the proper box
4683 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4684 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4688 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4689 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4690 C Condition for being inside the proper box
4691 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4692 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4696 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4697 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4698 cC Condition for being inside the proper box
4699 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4700 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4704 if (xi.lt.0) xi=xi+boxxsize
4706 if (yi.lt.0) yi=yi+boxysize
4708 if (zi.lt.0) zi=zi+boxzsize
4709 C xi=xi+xshift*boxxsize
4710 C yi=yi+yshift*boxysize
4711 C zi=zi+zshift*boxzsize
4712 do iint=1,nscp_gr(i)
4714 do j=iscpstart(i,iint),iscpend(i,iint)
4715 if (itype(j).eq.ntyp1) cycle
4716 itypj=iabs(itype(j))
4717 C Uncomment following three lines for SC-p interactions
4721 C Uncomment following three lines for Ca-p interactions
4726 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4727 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4728 C Condition for being inside the proper box
4729 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4730 c & (xj.lt.((-0.5d0)*boxxsize))) then
4734 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4735 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4736 cC Condition for being inside the proper box
4737 c if ((yj.gt.((0.5d0)*boxysize)).or.
4738 c & (yj.lt.((-0.5d0)*boxysize))) then
4742 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4743 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4744 C Condition for being inside the proper box
4745 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4746 c & (zj.lt.((-0.5d0)*boxzsize))) then
4749 if (xj.lt.0) xj=xj+boxxsize
4751 if (yj.lt.0) yj=yj+boxysize
4753 if (zj.lt.0) zj=zj+boxzsize
4754 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4762 xj=xj_safe+xshift*boxxsize
4763 yj=yj_safe+yshift*boxysize
4764 zj=zj_safe+zshift*boxzsize
4765 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4766 if(dist_temp.lt.dist_init) then
4776 if (subchap.eq.1) then
4789 rij=xj*xj+yj*yj+zj*zj
4793 if (rij.lt.r0ijsq) then
4794 evdwij=0.25d0*(rij-r0ijsq)**2
4802 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4807 cgrad if (j.lt.i) then
4808 cd write (iout,*) 'j<i'
4809 C Uncomment following three lines for SC-p interactions
4811 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4814 cd write (iout,*) 'j>i'
4816 cgrad ggg(k)=-ggg(k)
4817 C Uncomment following line for SC-p interactions
4818 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4822 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4824 cgrad kstart=min0(i+1,j)
4825 cgrad kend=max0(i-1,j-1)
4826 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4827 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4828 cgrad do k=kstart,kend
4830 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4834 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4835 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4846 C-----------------------------------------------------------------------------
4847 subroutine escp(evdw2,evdw2_14)
4849 C This subroutine calculates the excluded-volume interaction energy between
4850 C peptide-group centers and side chains and its gradient in virtual-bond and
4851 C side-chain vectors.
4853 implicit real*8 (a-h,o-z)
4854 include 'DIMENSIONS'
4855 include 'COMMON.GEO'
4856 include 'COMMON.VAR'
4857 include 'COMMON.LOCAL'
4858 include 'COMMON.CHAIN'
4859 include 'COMMON.DERIV'
4860 include 'COMMON.INTERACT'
4861 include 'COMMON.FFIELD'
4862 include 'COMMON.IOUNITS'
4863 include 'COMMON.CONTROL'
4864 include 'COMMON.SPLITELE'
4868 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
4869 cd print '(a)','Enter ESCP'
4870 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4874 do i=iatscp_s,iatscp_e
4875 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4877 xi=0.5D0*(c(1,i)+c(1,i+1))
4878 yi=0.5D0*(c(2,i)+c(2,i+1))
4879 zi=0.5D0*(c(3,i)+c(3,i+1))
4881 if (xi.lt.0) xi=xi+boxxsize
4883 if (yi.lt.0) yi=yi+boxysize
4885 if (zi.lt.0) zi=zi+boxzsize
4886 c xi=xi+xshift*boxxsize
4887 c yi=yi+yshift*boxysize
4888 c zi=zi+zshift*boxzsize
4889 c print *,xi,yi,zi,'polozenie i'
4890 C Return atom into box, boxxsize is size of box in x dimension
4892 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4893 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4894 C Condition for being inside the proper box
4895 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4896 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4900 c print *,xi,boxxsize,"pierwszy"
4902 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4903 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4904 C Condition for being inside the proper box
4905 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4906 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4910 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4911 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4912 C Condition for being inside the proper box
4913 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4914 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4917 do iint=1,nscp_gr(i)
4919 do j=iscpstart(i,iint),iscpend(i,iint)
4920 itypj=iabs(itype(j))
4921 if (itypj.eq.ntyp1) cycle
4922 C Uncomment following three lines for SC-p interactions
4926 C Uncomment following three lines for Ca-p interactions
4931 if (xj.lt.0) xj=xj+boxxsize
4933 if (yj.lt.0) yj=yj+boxysize
4935 if (zj.lt.0) zj=zj+boxzsize
4937 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4938 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4939 C Condition for being inside the proper box
4940 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4941 c & (xj.lt.((-0.5d0)*boxxsize))) then
4945 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4946 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4947 cC Condition for being inside the proper box
4948 c if ((yj.gt.((0.5d0)*boxysize)).or.
4949 c & (yj.lt.((-0.5d0)*boxysize))) then
4953 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4954 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4955 C Condition for being inside the proper box
4956 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4957 c & (zj.lt.((-0.5d0)*boxzsize))) then
4960 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
4961 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4969 xj=xj_safe+xshift*boxxsize
4970 yj=yj_safe+yshift*boxysize
4971 zj=zj_safe+zshift*boxzsize
4972 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4973 if(dist_temp.lt.dist_init) then
4983 if (subchap.eq.1) then
4992 c print *,xj,yj,zj,'polozenie j'
4993 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4995 sss=sscale(1.0d0/(dsqrt(rrij)))
4996 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
4997 c if (sss.eq.0) print *,'czasem jest OK'
4998 if (sss.le.0.0d0) cycle
4999 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5001 e1=fac*fac*aad(itypj,iteli)
5002 e2=fac*bad(itypj,iteli)
5003 if (iabs(j-i) .le. 2) then
5006 evdw2_14=evdw2_14+(e1+e2)*sss
5009 evdw2=evdw2+evdwij*sss
5010 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5011 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
5014 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5016 fac=-(evdwij+e1)*rrij*sss
5017 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5021 cgrad if (j.lt.i) then
5022 cd write (iout,*) 'j<i'
5023 C Uncomment following three lines for SC-p interactions
5025 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5028 cd write (iout,*) 'j>i'
5030 cgrad ggg(k)=-ggg(k)
5031 C Uncomment following line for SC-p interactions
5032 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5033 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5037 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5039 cgrad kstart=min0(i+1,j)
5040 cgrad kend=max0(i-1,j-1)
5041 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5042 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5043 cgrad do k=kstart,kend
5045 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5049 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5050 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5052 c endif !endif for sscale cutoff
5062 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5063 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5064 gradx_scp(j,i)=expon*gradx_scp(j,i)
5067 C******************************************************************************
5071 C To save time the factor EXPON has been extracted from ALL components
5072 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5075 C******************************************************************************
5078 C--------------------------------------------------------------------------
5079 subroutine edis(ehpb)
5081 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5083 implicit real*8 (a-h,o-z)
5084 include 'DIMENSIONS'
5085 include 'COMMON.SBRIDGE'
5086 include 'COMMON.CHAIN'
5087 include 'COMMON.DERIV'
5088 include 'COMMON.VAR'
5089 include 'COMMON.INTERACT'
5090 include 'COMMON.IOUNITS'
5093 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5094 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
5095 if (link_end.eq.0) return
5096 do i=link_start,link_end
5097 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5098 C CA-CA distance used in regularization of structure.
5101 C iii and jjj point to the residues for which the distance is assigned.
5102 if (ii.gt.nres) then
5109 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5110 c & dhpb(i),dhpb1(i),forcon(i)
5111 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5112 C distance and angle dependent SS bond potential.
5113 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5114 C & iabs(itype(jjj)).eq.1) then
5115 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5116 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5117 if (.not.dyn_ss .and. i.le.nss) then
5118 C 15/02/13 CC dynamic SSbond - additional check
5120 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5121 call ssbond_ene(iii,jjj,eij)
5124 cd write (iout,*) "eij",eij
5126 C Calculate the distance between the two points and its difference from the
5130 C Get the force constant corresponding to this distance.
5132 C Calculate the contribution to energy.
5133 ehpb=ehpb+waga*rdis*rdis
5135 C Evaluate gradient.
5138 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
5139 cd & ' waga=',waga,' fac=',fac
5141 ggg(j)=fac*(c(j,jj)-c(j,ii))
5143 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5144 C If this is a SC-SC distance, we need to calculate the contributions to the
5145 C Cartesian gradient in the SC vectors (ghpbx).
5148 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5149 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5152 cgrad do j=iii,jjj-1
5154 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5158 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5159 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5166 C--------------------------------------------------------------------------
5167 subroutine ssbond_ene(i,j,eij)
5169 C Calculate the distance and angle dependent SS-bond potential energy
5170 C using a free-energy function derived based on RHF/6-31G** ab initio
5171 C calculations of diethyl disulfide.
5173 C A. Liwo and U. Kozlowska, 11/24/03
5175 implicit real*8 (a-h,o-z)
5176 include 'DIMENSIONS'
5177 include 'COMMON.SBRIDGE'
5178 include 'COMMON.CHAIN'
5179 include 'COMMON.DERIV'
5180 include 'COMMON.LOCAL'
5181 include 'COMMON.INTERACT'
5182 include 'COMMON.VAR'
5183 include 'COMMON.IOUNITS'
5184 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5185 itypi=iabs(itype(i))
5189 dxi=dc_norm(1,nres+i)
5190 dyi=dc_norm(2,nres+i)
5191 dzi=dc_norm(3,nres+i)
5192 c dsci_inv=dsc_inv(itypi)
5193 dsci_inv=vbld_inv(nres+i)
5194 itypj=iabs(itype(j))
5195 c dscj_inv=dsc_inv(itypj)
5196 dscj_inv=vbld_inv(nres+j)
5200 dxj=dc_norm(1,nres+j)
5201 dyj=dc_norm(2,nres+j)
5202 dzj=dc_norm(3,nres+j)
5203 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5208 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5209 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5210 om12=dxi*dxj+dyi*dyj+dzi*dzj
5212 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5213 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5219 deltat12=om2-om1+2.0d0
5221 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5222 & +akct*deltad*deltat12
5223 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5224 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5225 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5226 c & " deltat12",deltat12," eij",eij
5227 ed=2*akcm*deltad+akct*deltat12
5229 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5230 eom1=-2*akth*deltat1-pom1-om2*pom2
5231 eom2= 2*akth*deltat2+pom1-om1*pom2
5234 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5235 ghpbx(k,i)=ghpbx(k,i)-ggk
5236 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5237 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5238 ghpbx(k,j)=ghpbx(k,j)+ggk
5239 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5240 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5241 ghpbc(k,i)=ghpbc(k,i)-ggk
5242 ghpbc(k,j)=ghpbc(k,j)+ggk
5245 C Calculate the components of the gradient in DC and X
5249 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5254 C--------------------------------------------------------------------------
5255 subroutine ebond(estr)
5257 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5259 implicit real*8 (a-h,o-z)
5260 include 'DIMENSIONS'
5261 include 'COMMON.LOCAL'
5262 include 'COMMON.GEO'
5263 include 'COMMON.INTERACT'
5264 include 'COMMON.DERIV'
5265 include 'COMMON.VAR'
5266 include 'COMMON.CHAIN'
5267 include 'COMMON.IOUNITS'
5268 include 'COMMON.NAMES'
5269 include 'COMMON.FFIELD'
5270 include 'COMMON.CONTROL'
5271 include 'COMMON.SETUP'
5272 double precision u(3),ud(3)
5275 do i=ibondp_start,ibondp_end
5276 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5277 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5279 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5280 c & *dc(j,i-1)/vbld(i)
5282 c if (energy_dec) write(iout,*)
5283 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5285 C Checking if it involves dummy (NH3+ or COO-) group
5286 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5287 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5288 diff = vbld(i)-vbldpDUM
5290 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5291 diff = vbld(i)-vbldp0
5293 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5294 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5297 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5299 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5302 estr=0.5d0*AKP*estr+estr1
5304 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5306 do i=ibond_start,ibond_end
5308 if (iti.ne.10 .and. iti.ne.ntyp1) then
5311 diff=vbld(i+nres)-vbldsc0(1,iti)
5312 if (energy_dec) write (iout,*)
5313 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5314 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5315 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5317 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5321 diff=vbld(i+nres)-vbldsc0(j,iti)
5322 ud(j)=aksc(j,iti)*diff
5323 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5337 uprod2=uprod2*u(k)*u(k)
5341 usumsqder=usumsqder+ud(j)*uprod2
5343 estr=estr+uprod/usum
5345 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5353 C--------------------------------------------------------------------------
5354 subroutine ebend(etheta)
5356 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5357 C angles gamma and its derivatives in consecutive thetas and gammas.
5359 implicit real*8 (a-h,o-z)
5360 include 'DIMENSIONS'
5361 include 'COMMON.LOCAL'
5362 include 'COMMON.GEO'
5363 include 'COMMON.INTERACT'
5364 include 'COMMON.DERIV'
5365 include 'COMMON.VAR'
5366 include 'COMMON.CHAIN'
5367 include 'COMMON.IOUNITS'
5368 include 'COMMON.NAMES'
5369 include 'COMMON.FFIELD'
5370 include 'COMMON.CONTROL'
5371 common /calcthet/ term1,term2,termm,diffak,ratak,
5372 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5373 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5374 double precision y(2),z(2)
5376 c time11=dexp(-2*time)
5379 c write (*,'(a,i2)') 'EBEND ICG=',icg
5380 do i=ithet_start,ithet_end
5381 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5382 & .or.itype(i).eq.ntyp1) cycle
5383 C Zero the energy function and its derivative at 0 or pi.
5384 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5386 ichir1=isign(1,itype(i-2))
5387 ichir2=isign(1,itype(i))
5388 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5389 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5390 if (itype(i-1).eq.10) then
5391 itype1=isign(10,itype(i-2))
5392 ichir11=isign(1,itype(i-2))
5393 ichir12=isign(1,itype(i-2))
5394 itype2=isign(10,itype(i))
5395 ichir21=isign(1,itype(i))
5396 ichir22=isign(1,itype(i))
5399 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5402 if (phii.ne.phii) phii=150.0
5412 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5415 if (phii1.ne.phii1) phii1=150.0
5427 C Calculate the "mean" value of theta from the part of the distribution
5428 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5429 C In following comments this theta will be referred to as t_c.
5430 thet_pred_mean=0.0d0
5432 athetk=athet(k,it,ichir1,ichir2)
5433 bthetk=bthet(k,it,ichir1,ichir2)
5435 athetk=athet(k,itype1,ichir11,ichir12)
5436 bthetk=bthet(k,itype2,ichir21,ichir22)
5438 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5439 c write(iout,*) 'chuj tu', y(k),z(k)
5441 dthett=thet_pred_mean*ssd
5442 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5443 C Derivatives of the "mean" values in gamma1 and gamma2.
5444 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5445 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5446 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5447 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5449 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5450 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5451 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5452 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5454 if (theta(i).gt.pi-delta) then
5455 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5457 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5458 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5459 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5461 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5463 else if (theta(i).lt.delta) then
5464 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5465 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5466 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5468 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5469 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5472 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5475 etheta=etheta+ethetai
5476 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5477 & 'ebend',i,ethetai,theta(i),itype(i)
5478 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5479 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5480 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5482 C Ufff.... We've done all this!!!
5485 C---------------------------------------------------------------------------
5486 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5488 implicit real*8 (a-h,o-z)
5489 include 'DIMENSIONS'
5490 include 'COMMON.LOCAL'
5491 include 'COMMON.IOUNITS'
5492 common /calcthet/ term1,term2,termm,diffak,ratak,
5493 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5494 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5495 C Calculate the contributions to both Gaussian lobes.
5496 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5497 C The "polynomial part" of the "standard deviation" of this part of
5498 C the distributioni.
5499 ccc write (iout,*) thetai,thet_pred_mean
5502 sig=sig*thet_pred_mean+polthet(j,it)
5504 C Derivative of the "interior part" of the "standard deviation of the"
5505 C gamma-dependent Gaussian lobe in t_c.
5506 sigtc=3*polthet(3,it)
5508 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5511 C Set the parameters of both Gaussian lobes of the distribution.
5512 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5513 fac=sig*sig+sigc0(it)
5516 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5517 sigsqtc=-4.0D0*sigcsq*sigtc
5518 c print *,i,sig,sigtc,sigsqtc
5519 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5520 sigtc=-sigtc/(fac*fac)
5521 C Following variable is sigma(t_c)**(-2)
5522 sigcsq=sigcsq*sigcsq
5524 sig0inv=1.0D0/sig0i**2
5525 delthec=thetai-thet_pred_mean
5526 delthe0=thetai-theta0i
5527 term1=-0.5D0*sigcsq*delthec*delthec
5528 term2=-0.5D0*sig0inv*delthe0*delthe0
5529 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5530 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5531 C NaNs in taking the logarithm. We extract the largest exponent which is added
5532 C to the energy (this being the log of the distribution) at the end of energy
5533 C term evaluation for this virtual-bond angle.
5534 if (term1.gt.term2) then
5536 term2=dexp(term2-termm)
5540 term1=dexp(term1-termm)
5543 C The ratio between the gamma-independent and gamma-dependent lobes of
5544 C the distribution is a Gaussian function of thet_pred_mean too.
5545 diffak=gthet(2,it)-thet_pred_mean
5546 ratak=diffak/gthet(3,it)**2
5547 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5548 C Let's differentiate it in thet_pred_mean NOW.
5550 C Now put together the distribution terms to make complete distribution.
5551 termexp=term1+ak*term2
5552 termpre=sigc+ak*sig0i
5553 C Contribution of the bending energy from this theta is just the -log of
5554 C the sum of the contributions from the two lobes and the pre-exponential
5555 C factor. Simple enough, isn't it?
5556 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5557 C write (iout,*) 'termexp',termexp,termm,termpre,i
5558 C NOW the derivatives!!!
5559 C 6/6/97 Take into account the deformation.
5560 E_theta=(delthec*sigcsq*term1
5561 & +ak*delthe0*sig0inv*term2)/termexp
5562 E_tc=((sigtc+aktc*sig0i)/termpre
5563 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5564 & aktc*term2)/termexp)
5567 c-----------------------------------------------------------------------------
5568 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5569 implicit real*8 (a-h,o-z)
5570 include 'DIMENSIONS'
5571 include 'COMMON.LOCAL'
5572 include 'COMMON.IOUNITS'
5573 common /calcthet/ term1,term2,termm,diffak,ratak,
5574 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5575 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5576 delthec=thetai-thet_pred_mean
5577 delthe0=thetai-theta0i
5578 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5579 t3 = thetai-thet_pred_mean
5583 t14 = t12+t6*sigsqtc
5585 t21 = thetai-theta0i
5591 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5592 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5593 & *(-t12*t9-ak*sig0inv*t27)
5597 C--------------------------------------------------------------------------
5598 subroutine ebend(etheta)
5600 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5601 C angles gamma and its derivatives in consecutive thetas and gammas.
5602 C ab initio-derived potentials from
5603 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5605 implicit real*8 (a-h,o-z)
5606 include 'DIMENSIONS'
5607 include 'COMMON.LOCAL'
5608 include 'COMMON.GEO'
5609 include 'COMMON.INTERACT'
5610 include 'COMMON.DERIV'
5611 include 'COMMON.VAR'
5612 include 'COMMON.CHAIN'
5613 include 'COMMON.IOUNITS'
5614 include 'COMMON.NAMES'
5615 include 'COMMON.FFIELD'
5616 include 'COMMON.CONTROL'
5617 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5618 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5619 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5620 & sinph1ph2(maxdouble,maxdouble)
5621 logical lprn /.false./, lprn1 /.false./
5623 do i=ithet_start,ithet_end
5624 c print *,i,itype(i-1),itype(i),itype(i-2)
5625 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5626 & .or.itype(i).eq.ntyp1) cycle
5627 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
5629 if (iabs(itype(i+1)).eq.20) iblock=2
5630 if (iabs(itype(i+1)).ne.20) iblock=1
5634 theti2=0.5d0*theta(i)
5635 ityp2=ithetyp((itype(i-1)))
5637 coskt(k)=dcos(k*theti2)
5638 sinkt(k)=dsin(k*theti2)
5640 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5643 if (phii.ne.phii) phii=150.0
5647 ityp1=ithetyp((itype(i-2)))
5648 C propagation of chirality for glycine type
5650 cosph1(k)=dcos(k*phii)
5651 sinph1(k)=dsin(k*phii)
5661 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5664 if (phii1.ne.phii1) phii1=150.0
5669 ityp3=ithetyp((itype(i)))
5671 cosph2(k)=dcos(k*phii1)
5672 sinph2(k)=dsin(k*phii1)
5682 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5685 ccl=cosph1(l)*cosph2(k-l)
5686 ssl=sinph1(l)*sinph2(k-l)
5687 scl=sinph1(l)*cosph2(k-l)
5688 csl=cosph1(l)*sinph2(k-l)
5689 cosph1ph2(l,k)=ccl-ssl
5690 cosph1ph2(k,l)=ccl+ssl
5691 sinph1ph2(l,k)=scl+csl
5692 sinph1ph2(k,l)=scl-csl
5696 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5697 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5698 write (iout,*) "coskt and sinkt"
5700 write (iout,*) k,coskt(k),sinkt(k)
5704 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5705 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5708 & write (iout,*) "k",k,"
5709 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5710 & " ethetai",ethetai
5713 write (iout,*) "cosph and sinph"
5715 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5717 write (iout,*) "cosph1ph2 and sinph2ph2"
5720 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5721 & sinph1ph2(l,k),sinph1ph2(k,l)
5724 write(iout,*) "ethetai",ethetai
5728 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5729 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5730 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5731 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5732 ethetai=ethetai+sinkt(m)*aux
5733 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5734 dephii=dephii+k*sinkt(m)*(
5735 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5736 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5737 dephii1=dephii1+k*sinkt(m)*(
5738 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5739 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5741 & write (iout,*) "m",m," k",k," bbthet",
5742 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5743 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5744 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5745 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5749 & write(iout,*) "ethetai",ethetai
5753 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5754 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5755 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5756 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5757 ethetai=ethetai+sinkt(m)*aux
5758 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5759 dephii=dephii+l*sinkt(m)*(
5760 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5761 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5762 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5763 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5764 dephii1=dephii1+(k-l)*sinkt(m)*(
5765 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5766 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5767 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5768 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5770 write (iout,*) "m",m," k",k," l",l," ffthet",
5771 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5772 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5773 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5774 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5775 & " ethetai",ethetai
5776 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5777 & cosph1ph2(k,l)*sinkt(m),
5778 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5786 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5787 & i,theta(i)*rad2deg,phii*rad2deg,
5788 & phii1*rad2deg,ethetai
5790 etheta=etheta+ethetai
5791 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5792 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5793 gloc(nphi+i-2,icg)=wang*dethetai+gloc(nphi+i-2,icg)
5799 c-----------------------------------------------------------------------------
5800 subroutine esc(escloc)
5801 C Calculate the local energy of a side chain and its derivatives in the
5802 C corresponding virtual-bond valence angles THETA and the spherical angles
5804 implicit real*8 (a-h,o-z)
5805 include 'DIMENSIONS'
5806 include 'COMMON.GEO'
5807 include 'COMMON.LOCAL'
5808 include 'COMMON.VAR'
5809 include 'COMMON.INTERACT'
5810 include 'COMMON.DERIV'
5811 include 'COMMON.CHAIN'
5812 include 'COMMON.IOUNITS'
5813 include 'COMMON.NAMES'
5814 include 'COMMON.FFIELD'
5815 include 'COMMON.CONTROL'
5816 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5817 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5818 common /sccalc/ time11,time12,time112,theti,it,nlobit
5821 c write (iout,'(a)') 'ESC'
5822 do i=loc_start,loc_end
5824 if (it.eq.ntyp1) cycle
5825 if (it.eq.10) goto 1
5826 nlobit=nlob(iabs(it))
5827 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5828 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5829 theti=theta(i+1)-pipol
5834 if (x(2).gt.pi-delta) then
5838 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5840 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5841 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5843 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5844 & ddersc0(1),dersc(1))
5845 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5846 & ddersc0(3),dersc(3))
5848 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5850 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5851 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5852 & dersc0(2),esclocbi,dersc02)
5853 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5855 call splinthet(x(2),0.5d0*delta,ss,ssd)
5860 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5862 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5863 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5865 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5867 c write (iout,*) escloci
5868 else if (x(2).lt.delta) then
5872 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5874 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5875 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5877 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5878 & ddersc0(1),dersc(1))
5879 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5880 & ddersc0(3),dersc(3))
5882 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5884 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5885 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5886 & dersc0(2),esclocbi,dersc02)
5887 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5892 call splinthet(x(2),0.5d0*delta,ss,ssd)
5894 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5896 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5897 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5899 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5900 c write (iout,*) escloci
5902 call enesc(x,escloci,dersc,ddummy,.false.)
5905 escloc=escloc+escloci
5906 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5907 & 'escloc',i,escloci
5908 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5910 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5912 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5913 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5918 C---------------------------------------------------------------------------
5919 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5920 implicit real*8 (a-h,o-z)
5921 include 'DIMENSIONS'
5922 include 'COMMON.GEO'
5923 include 'COMMON.LOCAL'
5924 include 'COMMON.IOUNITS'
5925 common /sccalc/ time11,time12,time112,theti,it,nlobit
5926 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5927 double precision contr(maxlob,-1:1)
5929 c write (iout,*) 'it=',it,' nlobit=',nlobit
5933 if (mixed) ddersc(j)=0.0d0
5937 C Because of periodicity of the dependence of the SC energy in omega we have
5938 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5939 C To avoid underflows, first compute & store the exponents.
5947 z(k)=x(k)-censc(k,j,it)
5952 Axk=Axk+gaussc(l,k,j,it)*z(l)
5958 expfac=expfac+Ax(k,j,iii)*z(k)
5966 C As in the case of ebend, we want to avoid underflows in exponentiation and
5967 C subsequent NaNs and INFs in energy calculation.
5968 C Find the largest exponent
5972 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5976 cd print *,'it=',it,' emin=',emin
5978 C Compute the contribution to SC energy and derivatives
5983 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5984 if(adexp.ne.adexp) adexp=1.0
5987 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5989 cd print *,'j=',j,' expfac=',expfac
5990 escloc_i=escloc_i+expfac
5992 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5996 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5997 & +gaussc(k,2,j,it))*expfac
6004 dersc(1)=dersc(1)/cos(theti)**2
6005 ddersc(1)=ddersc(1)/cos(theti)**2
6008 escloci=-(dlog(escloc_i)-emin)
6010 dersc(j)=dersc(j)/escloc_i
6014 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6019 C------------------------------------------------------------------------------
6020 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6021 implicit real*8 (a-h,o-z)
6022 include 'DIMENSIONS'
6023 include 'COMMON.GEO'
6024 include 'COMMON.LOCAL'
6025 include 'COMMON.IOUNITS'
6026 common /sccalc/ time11,time12,time112,theti,it,nlobit
6027 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6028 double precision contr(maxlob)
6039 z(k)=x(k)-censc(k,j,it)
6045 Axk=Axk+gaussc(l,k,j,it)*z(l)
6051 expfac=expfac+Ax(k,j)*z(k)
6056 C As in the case of ebend, we want to avoid underflows in exponentiation and
6057 C subsequent NaNs and INFs in energy calculation.
6058 C Find the largest exponent
6061 if (emin.gt.contr(j)) emin=contr(j)
6065 C Compute the contribution to SC energy and derivatives
6069 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6070 escloc_i=escloc_i+expfac
6072 dersc(k)=dersc(k)+Ax(k,j)*expfac
6074 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6075 & +gaussc(1,2,j,it))*expfac
6079 dersc(1)=dersc(1)/cos(theti)**2
6080 dersc12=dersc12/cos(theti)**2
6081 escloci=-(dlog(escloc_i)-emin)
6083 dersc(j)=dersc(j)/escloc_i
6085 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6089 c----------------------------------------------------------------------------------
6090 subroutine esc(escloc)
6091 C Calculate the local energy of a side chain and its derivatives in the
6092 C corresponding virtual-bond valence angles THETA and the spherical angles
6093 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6094 C added by Urszula Kozlowska. 07/11/2007
6096 implicit real*8 (a-h,o-z)
6097 include 'DIMENSIONS'
6098 include 'COMMON.GEO'
6099 include 'COMMON.LOCAL'
6100 include 'COMMON.VAR'
6101 include 'COMMON.SCROT'
6102 include 'COMMON.INTERACT'
6103 include 'COMMON.DERIV'
6104 include 'COMMON.CHAIN'
6105 include 'COMMON.IOUNITS'
6106 include 'COMMON.NAMES'
6107 include 'COMMON.FFIELD'
6108 include 'COMMON.CONTROL'
6109 include 'COMMON.VECTORS'
6110 double precision x_prime(3),y_prime(3),z_prime(3)
6111 & , sumene,dsc_i,dp2_i,x(65),
6112 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6113 & de_dxx,de_dyy,de_dzz,de_dt
6114 double precision s1_t,s1_6_t,s2_t,s2_6_t
6116 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6117 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6118 & dt_dCi(3),dt_dCi1(3)
6119 common /sccalc/ time11,time12,time112,theti,it,nlobit
6122 do i=loc_start,loc_end
6123 if (itype(i).eq.ntyp1) cycle
6124 costtab(i+1) =dcos(theta(i+1))
6125 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6126 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6127 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6128 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6129 cosfac=dsqrt(cosfac2)
6130 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6131 sinfac=dsqrt(sinfac2)
6133 if (it.eq.10) goto 1
6135 C Compute the axes of tghe local cartesian coordinates system; store in
6136 c x_prime, y_prime and z_prime
6143 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6144 C & dc_norm(3,i+nres)
6146 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6147 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6150 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6153 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6154 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6155 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6156 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6157 c & " xy",scalar(x_prime(1),y_prime(1)),
6158 c & " xz",scalar(x_prime(1),z_prime(1)),
6159 c & " yy",scalar(y_prime(1),y_prime(1)),
6160 c & " yz",scalar(y_prime(1),z_prime(1)),
6161 c & " zz",scalar(z_prime(1),z_prime(1))
6163 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6164 C to local coordinate system. Store in xx, yy, zz.
6170 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6171 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6172 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6179 C Compute the energy of the ith side cbain
6181 c write (2,*) "xx",xx," yy",yy," zz",zz
6184 x(j) = sc_parmin(j,it)
6187 Cc diagnostics - remove later
6189 yy1 = dsin(alph(2))*dcos(omeg(2))
6190 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
6191 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6192 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6194 C," --- ", xx_w,yy_w,zz_w
6197 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6198 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6200 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6201 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6203 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6204 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6205 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6206 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6207 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6209 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6210 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6211 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6212 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6213 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6215 dsc_i = 0.743d0+x(61)
6217 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6218 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6219 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6220 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6221 s1=(1+x(63))/(0.1d0 + dscp1)
6222 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6223 s2=(1+x(65))/(0.1d0 + dscp2)
6224 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6225 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6226 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6227 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6229 c & dscp1,dscp2,sumene
6230 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6231 escloc = escloc + sumene
6232 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6237 C This section to check the numerical derivatives of the energy of ith side
6238 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6239 C #define DEBUG in the code to turn it on.
6241 write (2,*) "sumene =",sumene
6245 write (2,*) xx,yy,zz
6246 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6247 de_dxx_num=(sumenep-sumene)/aincr
6249 write (2,*) "xx+ sumene from enesc=",sumenep
6252 write (2,*) xx,yy,zz
6253 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6254 de_dyy_num=(sumenep-sumene)/aincr
6256 write (2,*) "yy+ sumene from enesc=",sumenep
6259 write (2,*) xx,yy,zz
6260 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6261 de_dzz_num=(sumenep-sumene)/aincr
6263 write (2,*) "zz+ sumene from enesc=",sumenep
6264 costsave=cost2tab(i+1)
6265 sintsave=sint2tab(i+1)
6266 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6267 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6268 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6269 de_dt_num=(sumenep-sumene)/aincr
6270 write (2,*) " t+ sumene from enesc=",sumenep
6271 cost2tab(i+1)=costsave
6272 sint2tab(i+1)=sintsave
6273 C End of diagnostics section.
6276 C Compute the gradient of esc
6278 c zz=zz*dsign(1.0,dfloat(itype(i)))
6279 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6280 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6281 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6282 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6283 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6284 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6285 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6286 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6287 pom1=(sumene3*sint2tab(i+1)+sumene1)
6288 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6289 pom2=(sumene4*cost2tab(i+1)+sumene2)
6290 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6291 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6292 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6293 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6295 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6296 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6297 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6299 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6300 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6301 & +(pom1+pom2)*pom_dx
6303 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6306 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6307 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6308 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6310 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6311 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6312 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6313 & +x(59)*zz**2 +x(60)*xx*zz
6314 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6315 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6316 & +(pom1-pom2)*pom_dy
6318 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6321 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6322 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6323 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6324 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6325 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6326 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6327 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6328 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6330 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6333 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6334 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6335 & +pom1*pom_dt1+pom2*pom_dt2
6337 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6342 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6343 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6344 cosfac2xx=cosfac2*xx
6345 sinfac2yy=sinfac2*yy
6347 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6349 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6351 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6352 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6353 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6354 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6355 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6356 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6357 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6358 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6359 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6360 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6364 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6365 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6366 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6367 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6370 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6371 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6372 dZZ_XYZ(k)=vbld_inv(i+nres)*
6373 & (z_prime(k)-zz*dC_norm(k,i+nres))
6375 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6376 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6380 dXX_Ctab(k,i)=dXX_Ci(k)
6381 dXX_C1tab(k,i)=dXX_Ci1(k)
6382 dYY_Ctab(k,i)=dYY_Ci(k)
6383 dYY_C1tab(k,i)=dYY_Ci1(k)
6384 dZZ_Ctab(k,i)=dZZ_Ci(k)
6385 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6386 dXX_XYZtab(k,i)=dXX_XYZ(k)
6387 dYY_XYZtab(k,i)=dYY_XYZ(k)
6388 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6392 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6393 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6394 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6395 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6396 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6398 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6399 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6400 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6401 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6402 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6403 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6404 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6405 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6407 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6408 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6410 C to check gradient call subroutine check_grad
6416 c------------------------------------------------------------------------------
6417 double precision function enesc(x,xx,yy,zz,cost2,sint2)
6419 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
6420 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6421 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6422 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6424 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6425 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6427 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6428 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6429 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6430 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6431 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6433 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6434 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6435 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6436 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6437 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6439 dsc_i = 0.743d0+x(61)
6441 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6442 & *(xx*cost2+yy*sint2))
6443 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6444 & *(xx*cost2-yy*sint2))
6445 s1=(1+x(63))/(0.1d0 + dscp1)
6446 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6447 s2=(1+x(65))/(0.1d0 + dscp2)
6448 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6449 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
6450 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
6455 c------------------------------------------------------------------------------
6456 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6458 C This procedure calculates two-body contact function g(rij) and its derivative:
6461 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6464 C where x=(rij-r0ij)/delta
6466 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6469 double precision rij,r0ij,eps0ij,fcont,fprimcont
6470 double precision x,x2,x4,delta
6474 if (x.lt.-1.0D0) then
6477 else if (x.le.1.0D0) then
6480 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6481 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6488 c------------------------------------------------------------------------------
6489 subroutine splinthet(theti,delta,ss,ssder)
6490 implicit real*8 (a-h,o-z)
6491 include 'DIMENSIONS'
6492 include 'COMMON.VAR'
6493 include 'COMMON.GEO'
6496 if (theti.gt.pipol) then
6497 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6499 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6504 c------------------------------------------------------------------------------
6505 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6507 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6508 double precision ksi,ksi2,ksi3,a1,a2,a3
6509 a1=fprim0*delta/(f1-f0)
6515 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6516 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6519 c------------------------------------------------------------------------------
6520 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6522 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6523 double precision ksi,ksi2,ksi3,a1,a2,a3
6528 a2=3*(f1x-f0x)-2*fprim0x*delta
6529 a3=fprim0x*delta-2*(f1x-f0x)
6530 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6533 C-----------------------------------------------------------------------------
6535 C-----------------------------------------------------------------------------
6536 subroutine etor(etors,edihcnstr)
6537 implicit real*8 (a-h,o-z)
6538 include 'DIMENSIONS'
6539 include 'COMMON.VAR'
6540 include 'COMMON.GEO'
6541 include 'COMMON.LOCAL'
6542 include 'COMMON.TORSION'
6543 include 'COMMON.INTERACT'
6544 include 'COMMON.DERIV'
6545 include 'COMMON.CHAIN'
6546 include 'COMMON.NAMES'
6547 include 'COMMON.IOUNITS'
6548 include 'COMMON.FFIELD'
6549 include 'COMMON.TORCNSTR'
6550 include 'COMMON.CONTROL'
6552 C Set lprn=.true. for debugging
6556 do i=iphi_start,iphi_end
6558 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6559 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6560 itori=itortyp(itype(i-2))
6561 itori1=itortyp(itype(i-1))
6564 C Proline-Proline pair is a special case...
6565 if (itori.eq.3 .and. itori1.eq.3) then
6566 if (phii.gt.-dwapi3) then
6568 fac=1.0D0/(1.0D0-cosphi)
6569 etorsi=v1(1,3,3)*fac
6570 etorsi=etorsi+etorsi
6571 etors=etors+etorsi-v1(1,3,3)
6572 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6573 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6576 v1ij=v1(j+1,itori,itori1)
6577 v2ij=v2(j+1,itori,itori1)
6580 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6581 if (energy_dec) etors_ii=etors_ii+
6582 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6583 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6587 v1ij=v1(j,itori,itori1)
6588 v2ij=v2(j,itori,itori1)
6591 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6592 if (energy_dec) etors_ii=etors_ii+
6593 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6594 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6597 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6600 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6601 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6602 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6603 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6604 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6606 ! 6/20/98 - dihedral angle constraints
6609 itori=idih_constr(i)
6612 if (difi.gt.drange(i)) then
6614 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6615 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6616 else if (difi.lt.-drange(i)) then
6618 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6619 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6621 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6622 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6624 ! write (iout,*) 'edihcnstr',edihcnstr
6627 c------------------------------------------------------------------------------
6628 subroutine etor_d(etors_d)
6632 c----------------------------------------------------------------------------
6634 subroutine etor(etors,edihcnstr)
6635 implicit real*8 (a-h,o-z)
6636 include 'DIMENSIONS'
6637 include 'COMMON.VAR'
6638 include 'COMMON.GEO'
6639 include 'COMMON.LOCAL'
6640 include 'COMMON.TORSION'
6641 include 'COMMON.INTERACT'
6642 include 'COMMON.DERIV'
6643 include 'COMMON.CHAIN'
6644 include 'COMMON.NAMES'
6645 include 'COMMON.IOUNITS'
6646 include 'COMMON.FFIELD'
6647 include 'COMMON.TORCNSTR'
6648 include 'COMMON.CONTROL'
6650 C Set lprn=.true. for debugging
6654 do i=iphi_start,iphi_end
6655 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6656 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6657 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6658 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6659 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6660 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6661 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6662 C For introducing the NH3+ and COO- group please check the etor_d for reference
6665 if (iabs(itype(i)).eq.20) then
6670 itori=itortyp(itype(i-2))
6671 itori1=itortyp(itype(i-1))
6674 C Regular cosine and sine terms
6675 do j=1,nterm(itori,itori1,iblock)
6676 v1ij=v1(j,itori,itori1,iblock)
6677 v2ij=v2(j,itori,itori1,iblock)
6680 etors=etors+v1ij*cosphi+v2ij*sinphi
6681 if (energy_dec) etors_ii=etors_ii+
6682 & v1ij*cosphi+v2ij*sinphi
6683 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6687 C E = SUM ----------------------------------- - v1
6688 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6690 cosphi=dcos(0.5d0*phii)
6691 sinphi=dsin(0.5d0*phii)
6692 do j=1,nlor(itori,itori1,iblock)
6693 vl1ij=vlor1(j,itori,itori1)
6694 vl2ij=vlor2(j,itori,itori1)
6695 vl3ij=vlor3(j,itori,itori1)
6696 pom=vl2ij*cosphi+vl3ij*sinphi
6697 pom1=1.0d0/(pom*pom+1.0d0)
6698 etors=etors+vl1ij*pom1
6699 if (energy_dec) etors_ii=etors_ii+
6702 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6704 C Subtract the constant term
6705 etors=etors-v0(itori,itori1,iblock)
6706 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6707 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6709 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6710 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6711 & (v1(j,itori,itori1,iblock),j=1,6),
6712 & (v2(j,itori,itori1,iblock),j=1,6)
6713 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6714 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6716 ! 6/20/98 - dihedral angle constraints
6718 c do i=1,ndih_constr
6719 do i=idihconstr_start,idihconstr_end
6720 itori=idih_constr(i)
6722 difi=pinorm(phii-phi0(i))
6723 if (difi.gt.drange(i)) then
6725 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6726 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6727 else if (difi.lt.-drange(i)) then
6729 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6730 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6734 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6735 cd & rad2deg*phi0(i), rad2deg*drange(i),
6736 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6738 cd write (iout,*) 'edihcnstr',edihcnstr
6741 c----------------------------------------------------------------------------
6742 subroutine etor_d(etors_d)
6743 C 6/23/01 Compute double torsional energy
6744 implicit real*8 (a-h,o-z)
6745 include 'DIMENSIONS'
6746 include 'COMMON.VAR'
6747 include 'COMMON.GEO'
6748 include 'COMMON.LOCAL'
6749 include 'COMMON.TORSION'
6750 include 'COMMON.INTERACT'
6751 include 'COMMON.DERIV'
6752 include 'COMMON.CHAIN'
6753 include 'COMMON.NAMES'
6754 include 'COMMON.IOUNITS'
6755 include 'COMMON.FFIELD'
6756 include 'COMMON.TORCNSTR'
6758 C Set lprn=.true. for debugging
6762 c write(iout,*) "a tu??"
6763 do i=iphid_start,iphid_end
6764 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6765 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6766 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6767 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6768 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6769 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6770 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6771 & (itype(i+1).eq.ntyp1)) cycle
6772 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6773 itori=itortyp(itype(i-2))
6774 itori1=itortyp(itype(i-1))
6775 itori2=itortyp(itype(i))
6781 if (iabs(itype(i+1)).eq.20) iblock=2
6782 C Iblock=2 Proline type
6783 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6784 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6785 C if (itype(i+1).eq.ntyp1) iblock=3
6786 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6787 C IS or IS NOT need for this
6788 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6789 C is (itype(i-3).eq.ntyp1) ntblock=2
6790 C ntblock is N-terminal blocking group
6792 C Regular cosine and sine terms
6793 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6794 C Example of changes for NH3+ blocking group
6795 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6796 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6797 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6798 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6799 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6800 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6801 cosphi1=dcos(j*phii)
6802 sinphi1=dsin(j*phii)
6803 cosphi2=dcos(j*phii1)
6804 sinphi2=dsin(j*phii1)
6805 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6806 & v2cij*cosphi2+v2sij*sinphi2
6807 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6808 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6810 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6812 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6813 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6814 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6815 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6816 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6817 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6818 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6819 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6820 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6821 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6822 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6823 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6824 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6825 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6828 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6829 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6834 c------------------------------------------------------------------------------
6835 subroutine eback_sc_corr(esccor)
6836 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6837 c conformational states; temporarily implemented as differences
6838 c between UNRES torsional potentials (dependent on three types of
6839 c residues) and the torsional potentials dependent on all 20 types
6840 c of residues computed from AM1 energy surfaces of terminally-blocked
6841 c amino-acid residues.
6842 implicit real*8 (a-h,o-z)
6843 include 'DIMENSIONS'
6844 include 'COMMON.VAR'
6845 include 'COMMON.GEO'
6846 include 'COMMON.LOCAL'
6847 include 'COMMON.TORSION'
6848 include 'COMMON.SCCOR'
6849 include 'COMMON.INTERACT'
6850 include 'COMMON.DERIV'
6851 include 'COMMON.CHAIN'
6852 include 'COMMON.NAMES'
6853 include 'COMMON.IOUNITS'
6854 include 'COMMON.FFIELD'
6855 include 'COMMON.CONTROL'
6857 C Set lprn=.true. for debugging
6860 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6862 do i=itau_start,itau_end
6863 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6865 isccori=isccortyp(itype(i-2))
6866 isccori1=isccortyp(itype(i-1))
6867 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6869 do intertyp=1,3 !intertyp
6870 cc Added 09 May 2012 (Adasko)
6871 cc Intertyp means interaction type of backbone mainchain correlation:
6872 c 1 = SC...Ca...Ca...Ca
6873 c 2 = Ca...Ca...Ca...SC
6874 c 3 = SC...Ca...Ca...SCi
6876 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6877 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6878 & (itype(i-1).eq.ntyp1)))
6879 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6880 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6881 & .or.(itype(i).eq.ntyp1)))
6882 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6883 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6884 & (itype(i-3).eq.ntyp1)))) cycle
6885 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6886 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6888 do j=1,nterm_sccor(isccori,isccori1)
6889 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6890 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6891 cosphi=dcos(j*tauangle(intertyp,i))
6892 sinphi=dsin(j*tauangle(intertyp,i))
6893 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6894 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6896 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6897 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6899 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6900 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6901 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6902 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6903 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6909 c----------------------------------------------------------------------------
6910 subroutine multibody(ecorr)
6911 C This subroutine calculates multi-body contributions to energy following
6912 C the idea of Skolnick et al. If side chains I and J make a contact and
6913 C at the same time side chains I+1 and J+1 make a contact, an extra
6914 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6915 implicit real*8 (a-h,o-z)
6916 include 'DIMENSIONS'
6917 include 'COMMON.IOUNITS'
6918 include 'COMMON.DERIV'
6919 include 'COMMON.INTERACT'
6920 include 'COMMON.CONTACTS'
6921 double precision gx(3),gx1(3)
6924 C Set lprn=.true. for debugging
6928 write (iout,'(a)') 'Contact function values:'
6930 write (iout,'(i2,20(1x,i2,f10.5))')
6931 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6946 num_conti=num_cont(i)
6947 num_conti1=num_cont(i1)
6952 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6953 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6954 cd & ' ishift=',ishift
6955 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6956 C The system gains extra energy.
6957 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6958 endif ! j1==j+-ishift
6967 c------------------------------------------------------------------------------
6968 double precision function esccorr(i,j,k,l,jj,kk)
6969 implicit real*8 (a-h,o-z)
6970 include 'DIMENSIONS'
6971 include 'COMMON.IOUNITS'
6972 include 'COMMON.DERIV'
6973 include 'COMMON.INTERACT'
6974 include 'COMMON.CONTACTS'
6975 double precision gx(3),gx1(3)
6980 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6981 C Calculate the multi-body contribution to energy.
6982 C Calculate multi-body contributions to the gradient.
6983 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6984 cd & k,l,(gacont(m,kk,k),m=1,3)
6986 gx(m) =ekl*gacont(m,jj,i)
6987 gx1(m)=eij*gacont(m,kk,k)
6988 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6989 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6990 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6991 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6995 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7000 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7006 c------------------------------------------------------------------------------
7007 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7008 C This subroutine calculates multi-body contributions to hydrogen-bonding
7009 implicit real*8 (a-h,o-z)
7010 include 'DIMENSIONS'
7011 include 'COMMON.IOUNITS'
7014 parameter (max_cont=maxconts)
7015 parameter (max_dim=26)
7016 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7017 double precision zapas(max_dim,maxconts,max_fg_procs),
7018 & zapas_recv(max_dim,maxconts,max_fg_procs)
7019 common /przechowalnia/ zapas
7020 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7021 & status_array(MPI_STATUS_SIZE,maxconts*2)
7023 include 'COMMON.SETUP'
7024 include 'COMMON.FFIELD'
7025 include 'COMMON.DERIV'
7026 include 'COMMON.INTERACT'
7027 include 'COMMON.CONTACTS'
7028 include 'COMMON.CONTROL'
7029 include 'COMMON.LOCAL'
7030 double precision gx(3),gx1(3),time00
7033 C Set lprn=.true. for debugging
7038 if (nfgtasks.le.1) goto 30
7040 write (iout,'(a)') 'Contact function values before RECEIVE:'
7042 write (iout,'(2i3,50(1x,i2,f5.2))')
7043 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7044 & j=1,num_cont_hb(i))
7048 do i=1,ntask_cont_from
7051 do i=1,ntask_cont_to
7054 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7056 C Make the list of contacts to send to send to other procesors
7057 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7059 do i=iturn3_start,iturn3_end
7060 c write (iout,*) "make contact list turn3",i," num_cont",
7062 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7064 do i=iturn4_start,iturn4_end
7065 c write (iout,*) "make contact list turn4",i," num_cont",
7067 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7071 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7073 do j=1,num_cont_hb(i)
7076 iproc=iint_sent_local(k,jjc,ii)
7077 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7078 if (iproc.gt.0) then
7079 ncont_sent(iproc)=ncont_sent(iproc)+1
7080 nn=ncont_sent(iproc)
7082 zapas(2,nn,iproc)=jjc
7083 zapas(3,nn,iproc)=facont_hb(j,i)
7084 zapas(4,nn,iproc)=ees0p(j,i)
7085 zapas(5,nn,iproc)=ees0m(j,i)
7086 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7087 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7088 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7089 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7090 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7091 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7092 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7093 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7094 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7095 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7096 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7097 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7098 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7099 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7100 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7101 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7102 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7103 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7104 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7105 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7106 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7113 & "Numbers of contacts to be sent to other processors",
7114 & (ncont_sent(i),i=1,ntask_cont_to)
7115 write (iout,*) "Contacts sent"
7116 do ii=1,ntask_cont_to
7118 iproc=itask_cont_to(ii)
7119 write (iout,*) nn," contacts to processor",iproc,
7120 & " of CONT_TO_COMM group"
7122 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7130 CorrelID1=nfgtasks+fg_rank+1
7132 C Receive the numbers of needed contacts from other processors
7133 do ii=1,ntask_cont_from
7134 iproc=itask_cont_from(ii)
7136 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7137 & FG_COMM,req(ireq),IERR)
7139 c write (iout,*) "IRECV ended"
7141 C Send the number of contacts needed by other processors
7142 do ii=1,ntask_cont_to
7143 iproc=itask_cont_to(ii)
7145 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7146 & FG_COMM,req(ireq),IERR)
7148 c write (iout,*) "ISEND ended"
7149 c write (iout,*) "number of requests (nn)",ireq
7152 & call MPI_Waitall(ireq,req,status_array,ierr)
7154 c & "Numbers of contacts to be received from other processors",
7155 c & (ncont_recv(i),i=1,ntask_cont_from)
7159 do ii=1,ntask_cont_from
7160 iproc=itask_cont_from(ii)
7162 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7163 c & " of CONT_TO_COMM group"
7167 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7168 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7169 c write (iout,*) "ireq,req",ireq,req(ireq)
7172 C Send the contacts to processors that need them
7173 do ii=1,ntask_cont_to
7174 iproc=itask_cont_to(ii)
7176 c write (iout,*) nn," contacts to processor",iproc,
7177 c & " of CONT_TO_COMM group"
7180 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7181 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7182 c write (iout,*) "ireq,req",ireq,req(ireq)
7184 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7188 c write (iout,*) "number of requests (contacts)",ireq
7189 c write (iout,*) "req",(req(i),i=1,4)
7192 & call MPI_Waitall(ireq,req,status_array,ierr)
7193 do iii=1,ntask_cont_from
7194 iproc=itask_cont_from(iii)
7197 write (iout,*) "Received",nn," contacts from processor",iproc,
7198 & " of CONT_FROM_COMM group"
7201 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7206 ii=zapas_recv(1,i,iii)
7207 c Flag the received contacts to prevent double-counting
7208 jj=-zapas_recv(2,i,iii)
7209 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7211 nnn=num_cont_hb(ii)+1
7214 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7215 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7216 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7217 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7218 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7219 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7220 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7221 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7222 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7223 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7224 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7225 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7226 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7227 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7228 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7229 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7230 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7231 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7232 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7233 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7234 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7235 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7236 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7237 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7242 write (iout,'(a)') 'Contact function values after receive:'
7244 write (iout,'(2i3,50(1x,i3,f5.2))')
7245 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7246 & j=1,num_cont_hb(i))
7253 write (iout,'(a)') 'Contact function values:'
7255 write (iout,'(2i3,50(1x,i3,f5.2))')
7256 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7257 & j=1,num_cont_hb(i))
7261 C Remove the loop below after debugging !!!
7268 C Calculate the local-electrostatic correlation terms
7269 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7271 num_conti=num_cont_hb(i)
7272 num_conti1=num_cont_hb(i+1)
7279 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7280 c & ' jj=',jj,' kk=',kk
7281 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7282 & .or. j.lt.0 .and. j1.gt.0) .and.
7283 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7284 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7285 C The system gains extra energy.
7286 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7287 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7288 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7290 else if (j1.eq.j) then
7291 C Contacts I-J and I-(J+1) occur simultaneously.
7292 C The system loses extra energy.
7293 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7298 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7299 c & ' jj=',jj,' kk=',kk
7301 C Contacts I-J and (I+1)-J occur simultaneously.
7302 C The system loses extra energy.
7303 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7310 c------------------------------------------------------------------------------
7311 subroutine add_hb_contact(ii,jj,itask)
7312 implicit real*8 (a-h,o-z)
7313 include "DIMENSIONS"
7314 include "COMMON.IOUNITS"
7317 parameter (max_cont=maxconts)
7318 parameter (max_dim=26)
7319 include "COMMON.CONTACTS"
7320 double precision zapas(max_dim,maxconts,max_fg_procs),
7321 & zapas_recv(max_dim,maxconts,max_fg_procs)
7322 common /przechowalnia/ zapas
7323 integer i,j,ii,jj,iproc,itask(4),nn
7324 c write (iout,*) "itask",itask
7327 if (iproc.gt.0) then
7328 do j=1,num_cont_hb(ii)
7330 c write (iout,*) "i",ii," j",jj," jjc",jjc
7332 ncont_sent(iproc)=ncont_sent(iproc)+1
7333 nn=ncont_sent(iproc)
7334 zapas(1,nn,iproc)=ii
7335 zapas(2,nn,iproc)=jjc
7336 zapas(3,nn,iproc)=facont_hb(j,ii)
7337 zapas(4,nn,iproc)=ees0p(j,ii)
7338 zapas(5,nn,iproc)=ees0m(j,ii)
7339 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7340 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7341 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7342 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7343 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7344 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7345 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7346 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7347 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7348 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7349 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7350 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7351 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7352 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7353 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7354 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7355 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7356 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7357 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7358 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7359 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7367 c------------------------------------------------------------------------------
7368 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7370 C This subroutine calculates multi-body contributions to hydrogen-bonding
7371 implicit real*8 (a-h,o-z)
7372 include 'DIMENSIONS'
7373 include 'COMMON.IOUNITS'
7376 parameter (max_cont=maxconts)
7377 parameter (max_dim=70)
7378 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7379 double precision zapas(max_dim,maxconts,max_fg_procs),
7380 & zapas_recv(max_dim,maxconts,max_fg_procs)
7381 common /przechowalnia/ zapas
7382 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7383 & status_array(MPI_STATUS_SIZE,maxconts*2)
7385 include 'COMMON.SETUP'
7386 include 'COMMON.FFIELD'
7387 include 'COMMON.DERIV'
7388 include 'COMMON.LOCAL'
7389 include 'COMMON.INTERACT'
7390 include 'COMMON.CONTACTS'
7391 include 'COMMON.CHAIN'
7392 include 'COMMON.CONTROL'
7393 double precision gx(3),gx1(3)
7394 integer num_cont_hb_old(maxres)
7396 double precision eello4,eello5,eelo6,eello_turn6
7397 external eello4,eello5,eello6,eello_turn6
7398 C Set lprn=.true. for debugging
7403 num_cont_hb_old(i)=num_cont_hb(i)
7407 if (nfgtasks.le.1) goto 30
7409 write (iout,'(a)') 'Contact function values before RECEIVE:'
7411 write (iout,'(2i3,50(1x,i2,f5.2))')
7412 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7413 & j=1,num_cont_hb(i))
7417 do i=1,ntask_cont_from
7420 do i=1,ntask_cont_to
7423 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7425 C Make the list of contacts to send to send to other procesors
7426 do i=iturn3_start,iturn3_end
7427 c write (iout,*) "make contact list turn3",i," num_cont",
7429 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7431 do i=iturn4_start,iturn4_end
7432 c write (iout,*) "make contact list turn4",i," num_cont",
7434 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7438 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7440 do j=1,num_cont_hb(i)
7443 iproc=iint_sent_local(k,jjc,ii)
7444 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7445 if (iproc.ne.0) then
7446 ncont_sent(iproc)=ncont_sent(iproc)+1
7447 nn=ncont_sent(iproc)
7449 zapas(2,nn,iproc)=jjc
7450 zapas(3,nn,iproc)=d_cont(j,i)
7454 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7459 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7467 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7478 & "Numbers of contacts to be sent to other processors",
7479 & (ncont_sent(i),i=1,ntask_cont_to)
7480 write (iout,*) "Contacts sent"
7481 do ii=1,ntask_cont_to
7483 iproc=itask_cont_to(ii)
7484 write (iout,*) nn," contacts to processor",iproc,
7485 & " of CONT_TO_COMM group"
7487 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7495 CorrelID1=nfgtasks+fg_rank+1
7497 C Receive the numbers of needed contacts from other processors
7498 do ii=1,ntask_cont_from
7499 iproc=itask_cont_from(ii)
7501 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7502 & FG_COMM,req(ireq),IERR)
7504 c write (iout,*) "IRECV ended"
7506 C Send the number of contacts needed by other processors
7507 do ii=1,ntask_cont_to
7508 iproc=itask_cont_to(ii)
7510 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7511 & FG_COMM,req(ireq),IERR)
7513 c write (iout,*) "ISEND ended"
7514 c write (iout,*) "number of requests (nn)",ireq
7517 & call MPI_Waitall(ireq,req,status_array,ierr)
7519 c & "Numbers of contacts to be received from other processors",
7520 c & (ncont_recv(i),i=1,ntask_cont_from)
7524 do ii=1,ntask_cont_from
7525 iproc=itask_cont_from(ii)
7527 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7528 c & " of CONT_TO_COMM group"
7532 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7533 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7534 c write (iout,*) "ireq,req",ireq,req(ireq)
7537 C Send the contacts to processors that need them
7538 do ii=1,ntask_cont_to
7539 iproc=itask_cont_to(ii)
7541 c write (iout,*) nn," contacts to processor",iproc,
7542 c & " of CONT_TO_COMM group"
7545 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7546 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7547 c write (iout,*) "ireq,req",ireq,req(ireq)
7549 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7553 c write (iout,*) "number of requests (contacts)",ireq
7554 c write (iout,*) "req",(req(i),i=1,4)
7557 & call MPI_Waitall(ireq,req,status_array,ierr)
7558 do iii=1,ntask_cont_from
7559 iproc=itask_cont_from(iii)
7562 write (iout,*) "Received",nn," contacts from processor",iproc,
7563 & " of CONT_FROM_COMM group"
7566 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7571 ii=zapas_recv(1,i,iii)
7572 c Flag the received contacts to prevent double-counting
7573 jj=-zapas_recv(2,i,iii)
7574 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7576 nnn=num_cont_hb(ii)+1
7579 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7583 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7588 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7596 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7605 write (iout,'(a)') 'Contact function values after receive:'
7607 write (iout,'(2i3,50(1x,i3,5f6.3))')
7608 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7609 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7616 write (iout,'(a)') 'Contact function values:'
7618 write (iout,'(2i3,50(1x,i2,5f6.3))')
7619 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7620 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7626 C Remove the loop below after debugging !!!
7633 C Calculate the dipole-dipole interaction energies
7634 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7635 do i=iatel_s,iatel_e+1
7636 num_conti=num_cont_hb(i)
7645 C Calculate the local-electrostatic correlation terms
7646 c write (iout,*) "gradcorr5 in eello5 before loop"
7648 c write (iout,'(i5,3f10.5)')
7649 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7651 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7652 c write (iout,*) "corr loop i",i
7654 num_conti=num_cont_hb(i)
7655 num_conti1=num_cont_hb(i+1)
7662 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7663 c & ' jj=',jj,' kk=',kk
7664 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7665 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7666 & .or. j.lt.0 .and. j1.gt.0) .and.
7667 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7668 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7669 C The system gains extra energy.
7671 sqd1=dsqrt(d_cont(jj,i))
7672 sqd2=dsqrt(d_cont(kk,i1))
7673 sred_geom = sqd1*sqd2
7674 IF (sred_geom.lt.cutoff_corr) THEN
7675 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7677 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7678 cd & ' jj=',jj,' kk=',kk
7679 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7680 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7682 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7683 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7686 cd write (iout,*) 'sred_geom=',sred_geom,
7687 cd & ' ekont=',ekont,' fprim=',fprimcont,
7688 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7689 cd write (iout,*) "g_contij",g_contij
7690 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7691 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7692 call calc_eello(i,jp,i+1,jp1,jj,kk)
7693 if (wcorr4.gt.0.0d0)
7694 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7695 if (energy_dec.and.wcorr4.gt.0.0d0)
7696 1 write (iout,'(a6,4i5,0pf7.3)')
7697 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7698 c write (iout,*) "gradcorr5 before eello5"
7700 c write (iout,'(i5,3f10.5)')
7701 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7703 if (wcorr5.gt.0.0d0)
7704 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7705 c write (iout,*) "gradcorr5 after eello5"
7707 c write (iout,'(i5,3f10.5)')
7708 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7710 if (energy_dec.and.wcorr5.gt.0.0d0)
7711 1 write (iout,'(a6,4i5,0pf7.3)')
7712 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7713 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7714 cd write(2,*)'ijkl',i,jp,i+1,jp1
7715 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7716 & .or. wturn6.eq.0.0d0))then
7717 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7718 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7719 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7720 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7721 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7722 cd & 'ecorr6=',ecorr6
7723 cd write (iout,'(4e15.5)') sred_geom,
7724 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7725 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7726 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7727 else if (wturn6.gt.0.0d0
7728 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7729 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7730 eturn6=eturn6+eello_turn6(i,jj,kk)
7731 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7732 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7733 cd write (2,*) 'multibody_eello:eturn6',eturn6
7742 num_cont_hb(i)=num_cont_hb_old(i)
7744 c write (iout,*) "gradcorr5 in eello5"
7746 c write (iout,'(i5,3f10.5)')
7747 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7751 c------------------------------------------------------------------------------
7752 subroutine add_hb_contact_eello(ii,jj,itask)
7753 implicit real*8 (a-h,o-z)
7754 include "DIMENSIONS"
7755 include "COMMON.IOUNITS"
7758 parameter (max_cont=maxconts)
7759 parameter (max_dim=70)
7760 include "COMMON.CONTACTS"
7761 double precision zapas(max_dim,maxconts,max_fg_procs),
7762 & zapas_recv(max_dim,maxconts,max_fg_procs)
7763 common /przechowalnia/ zapas
7764 integer i,j,ii,jj,iproc,itask(4),nn
7765 c write (iout,*) "itask",itask
7768 if (iproc.gt.0) then
7769 do j=1,num_cont_hb(ii)
7771 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7773 ncont_sent(iproc)=ncont_sent(iproc)+1
7774 nn=ncont_sent(iproc)
7775 zapas(1,nn,iproc)=ii
7776 zapas(2,nn,iproc)=jjc
7777 zapas(3,nn,iproc)=d_cont(j,ii)
7781 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7786 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7794 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7806 c------------------------------------------------------------------------------
7807 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7808 implicit real*8 (a-h,o-z)
7809 include 'DIMENSIONS'
7810 include 'COMMON.IOUNITS'
7811 include 'COMMON.DERIV'
7812 include 'COMMON.INTERACT'
7813 include 'COMMON.CONTACTS'
7814 double precision gx(3),gx1(3)
7824 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7825 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7826 C Following 4 lines for diagnostics.
7831 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7832 c & 'Contacts ',i,j,
7833 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7834 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7836 C Calculate the multi-body contribution to energy.
7837 c ecorr=ecorr+ekont*ees
7838 C Calculate multi-body contributions to the gradient.
7839 coeffpees0pij=coeffp*ees0pij
7840 coeffmees0mij=coeffm*ees0mij
7841 coeffpees0pkl=coeffp*ees0pkl
7842 coeffmees0mkl=coeffm*ees0mkl
7844 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7845 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7846 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7847 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7848 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7849 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7850 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7851 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7852 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7853 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7854 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7855 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7856 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7857 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7858 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7859 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7860 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7861 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7862 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7863 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7864 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7865 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7866 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7867 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7868 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7873 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7874 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7875 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7876 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7881 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7882 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7883 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7884 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7887 c write (iout,*) "ehbcorr",ekont*ees
7892 C---------------------------------------------------------------------------
7893 subroutine dipole(i,j,jj)
7894 implicit real*8 (a-h,o-z)
7895 include 'DIMENSIONS'
7896 include 'COMMON.IOUNITS'
7897 include 'COMMON.CHAIN'
7898 include 'COMMON.FFIELD'
7899 include 'COMMON.DERIV'
7900 include 'COMMON.INTERACT'
7901 include 'COMMON.CONTACTS'
7902 include 'COMMON.TORSION'
7903 include 'COMMON.VAR'
7904 include 'COMMON.GEO'
7905 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7907 iti1 = itortyp(itype(i+1))
7908 if (j.lt.nres-1) then
7909 itj1 = itortyp(itype(j+1))
7914 dipi(iii,1)=Ub2(iii,i)
7915 dipderi(iii)=Ub2der(iii,i)
7916 dipi(iii,2)=b1(iii,i+1)
7917 dipj(iii,1)=Ub2(iii,j)
7918 dipderj(iii)=Ub2der(iii,j)
7919 dipj(iii,2)=b1(iii,j+1)
7923 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7926 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7933 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7937 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7942 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7943 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7945 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7947 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7949 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7954 C---------------------------------------------------------------------------
7955 subroutine calc_eello(i,j,k,l,jj,kk)
7957 C This subroutine computes matrices and vectors needed to calculate
7958 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7960 implicit real*8 (a-h,o-z)
7961 include 'DIMENSIONS'
7962 include 'COMMON.IOUNITS'
7963 include 'COMMON.CHAIN'
7964 include 'COMMON.DERIV'
7965 include 'COMMON.INTERACT'
7966 include 'COMMON.CONTACTS'
7967 include 'COMMON.TORSION'
7968 include 'COMMON.VAR'
7969 include 'COMMON.GEO'
7970 include 'COMMON.FFIELD'
7971 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7972 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7975 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7976 cd & ' jj=',jj,' kk=',kk
7977 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7978 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7979 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7982 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7983 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7986 call transpose2(aa1(1,1),aa1t(1,1))
7987 call transpose2(aa2(1,1),aa2t(1,1))
7990 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7991 & aa1tder(1,1,lll,kkk))
7992 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7993 & aa2tder(1,1,lll,kkk))
7997 C parallel orientation of the two CA-CA-CA frames.
7999 iti=itortyp(itype(i))
8003 itk1=itortyp(itype(k+1))
8004 itj=itortyp(itype(j))
8005 if (l.lt.nres-1) then
8006 itl1=itortyp(itype(l+1))
8010 C A1 kernel(j+1) A2T
8012 cd write (iout,'(3f10.5,5x,3f10.5)')
8013 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8015 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8016 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8017 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8018 C Following matrices are needed only for 6-th order cumulants
8019 IF (wcorr6.gt.0.0d0) THEN
8020 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8021 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8022 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8023 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8024 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8025 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8026 & ADtEAderx(1,1,1,1,1,1))
8028 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8029 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8030 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8031 & ADtEA1derx(1,1,1,1,1,1))
8033 C End 6-th order cumulants
8036 cd write (2,*) 'In calc_eello6'
8038 cd write (2,*) 'iii=',iii
8040 cd write (2,*) 'kkk=',kkk
8042 cd write (2,'(3(2f10.5),5x)')
8043 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8048 call transpose2(EUgder(1,1,k),auxmat(1,1))
8049 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8050 call transpose2(EUg(1,1,k),auxmat(1,1))
8051 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8052 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8056 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8057 & EAEAderx(1,1,lll,kkk,iii,1))
8061 C A1T kernel(i+1) A2
8062 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8063 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8064 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8065 C Following matrices are needed only for 6-th order cumulants
8066 IF (wcorr6.gt.0.0d0) THEN
8067 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8068 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
8069 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8070 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8071 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
8072 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8073 & ADtEAderx(1,1,1,1,1,2))
8074 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8075 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
8076 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8077 & ADtEA1derx(1,1,1,1,1,2))
8079 C End 6-th order cumulants
8080 call transpose2(EUgder(1,1,l),auxmat(1,1))
8081 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8082 call transpose2(EUg(1,1,l),auxmat(1,1))
8083 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8084 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8088 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8089 & EAEAderx(1,1,lll,kkk,iii,2))
8094 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8095 C They are needed only when the fifth- or the sixth-order cumulants are
8097 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8098 call transpose2(AEA(1,1,1),auxmat(1,1))
8099 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8100 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8101 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8102 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8103 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8104 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8105 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8106 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8107 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8108 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8109 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8110 call transpose2(AEA(1,1,2),auxmat(1,1))
8111 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
8112 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8113 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8114 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8115 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
8116 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8117 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
8118 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
8119 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8120 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8121 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8122 C Calculate the Cartesian derivatives of the vectors.
8126 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8127 call matvec2(auxmat(1,1),b1(1,i),
8128 & AEAb1derx(1,lll,kkk,iii,1,1))
8129 call matvec2(auxmat(1,1),Ub2(1,i),
8130 & AEAb2derx(1,lll,kkk,iii,1,1))
8131 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8132 & AEAb1derx(1,lll,kkk,iii,2,1))
8133 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8134 & AEAb2derx(1,lll,kkk,iii,2,1))
8135 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8136 call matvec2(auxmat(1,1),b1(1,j),
8137 & AEAb1derx(1,lll,kkk,iii,1,2))
8138 call matvec2(auxmat(1,1),Ub2(1,j),
8139 & AEAb2derx(1,lll,kkk,iii,1,2))
8140 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8141 & AEAb1derx(1,lll,kkk,iii,2,2))
8142 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
8143 & AEAb2derx(1,lll,kkk,iii,2,2))
8150 C Antiparallel orientation of the two CA-CA-CA frames.
8152 iti=itortyp(itype(i))
8156 itk1=itortyp(itype(k+1))
8157 itl=itortyp(itype(l))
8158 itj=itortyp(itype(j))
8159 if (j.lt.nres-1) then
8160 itj1=itortyp(itype(j+1))
8164 C A2 kernel(j-1)T A1T
8165 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8166 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
8167 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8168 C Following matrices are needed only for 6-th order cumulants
8169 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8170 & j.eq.i+4 .and. l.eq.i+3)) THEN
8171 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8172 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
8173 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8174 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8175 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8176 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8177 & ADtEAderx(1,1,1,1,1,1))
8178 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8179 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8180 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8181 & ADtEA1derx(1,1,1,1,1,1))
8183 C End 6-th order cumulants
8184 call transpose2(EUgder(1,1,k),auxmat(1,1))
8185 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8186 call transpose2(EUg(1,1,k),auxmat(1,1))
8187 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8188 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8192 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8193 & EAEAderx(1,1,lll,kkk,iii,1))
8197 C A2T kernel(i+1)T A1
8198 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8199 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
8200 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8201 C Following matrices are needed only for 6-th order cumulants
8202 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8203 & j.eq.i+4 .and. l.eq.i+3)) THEN
8204 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8205 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8206 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8207 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8208 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8209 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8210 & ADtEAderx(1,1,1,1,1,2))
8211 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8212 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8213 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8214 & ADtEA1derx(1,1,1,1,1,2))
8216 C End 6-th order cumulants
8217 call transpose2(EUgder(1,1,j),auxmat(1,1))
8218 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8219 call transpose2(EUg(1,1,j),auxmat(1,1))
8220 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8221 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8225 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8226 & EAEAderx(1,1,lll,kkk,iii,2))
8231 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8232 C They are needed only when the fifth- or the sixth-order cumulants are
8234 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8235 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8236 call transpose2(AEA(1,1,1),auxmat(1,1))
8237 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8238 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8239 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8240 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8241 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8242 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8243 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8244 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8245 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8246 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8247 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8248 call transpose2(AEA(1,1,2),auxmat(1,1))
8249 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
8250 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8251 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8252 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8253 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
8254 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8255 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
8256 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
8257 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8258 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8259 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8260 C Calculate the Cartesian derivatives of the vectors.
8264 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8265 call matvec2(auxmat(1,1),b1(1,i),
8266 & AEAb1derx(1,lll,kkk,iii,1,1))
8267 call matvec2(auxmat(1,1),Ub2(1,i),
8268 & AEAb2derx(1,lll,kkk,iii,1,1))
8269 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8270 & AEAb1derx(1,lll,kkk,iii,2,1))
8271 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8272 & AEAb2derx(1,lll,kkk,iii,2,1))
8273 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8274 call matvec2(auxmat(1,1),b1(1,l),
8275 & AEAb1derx(1,lll,kkk,iii,1,2))
8276 call matvec2(auxmat(1,1),Ub2(1,l),
8277 & AEAb2derx(1,lll,kkk,iii,1,2))
8278 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
8279 & AEAb1derx(1,lll,kkk,iii,2,2))
8280 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8281 & AEAb2derx(1,lll,kkk,iii,2,2))
8290 C---------------------------------------------------------------------------
8291 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8292 & KK,KKderg,AKA,AKAderg,AKAderx)
8296 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8297 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8298 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8303 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8305 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8308 cd if (lprn) write (2,*) 'In kernel'
8310 cd if (lprn) write (2,*) 'kkk=',kkk
8312 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8313 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8315 cd write (2,*) 'lll=',lll
8316 cd write (2,*) 'iii=1'
8318 cd write (2,'(3(2f10.5),5x)')
8319 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8322 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8323 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8325 cd write (2,*) 'lll=',lll
8326 cd write (2,*) 'iii=2'
8328 cd write (2,'(3(2f10.5),5x)')
8329 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8336 C---------------------------------------------------------------------------
8337 double precision function eello4(i,j,k,l,jj,kk)
8338 implicit real*8 (a-h,o-z)
8339 include 'DIMENSIONS'
8340 include 'COMMON.IOUNITS'
8341 include 'COMMON.CHAIN'
8342 include 'COMMON.DERIV'
8343 include 'COMMON.INTERACT'
8344 include 'COMMON.CONTACTS'
8345 include 'COMMON.TORSION'
8346 include 'COMMON.VAR'
8347 include 'COMMON.GEO'
8348 double precision pizda(2,2),ggg1(3),ggg2(3)
8349 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8353 cd print *,'eello4:',i,j,k,l,jj,kk
8354 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8355 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8356 cold eij=facont_hb(jj,i)
8357 cold ekl=facont_hb(kk,k)
8359 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8360 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8361 gcorr_loc(k-1)=gcorr_loc(k-1)
8362 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8364 gcorr_loc(l-1)=gcorr_loc(l-1)
8365 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8367 gcorr_loc(j-1)=gcorr_loc(j-1)
8368 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8373 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8374 & -EAEAderx(2,2,lll,kkk,iii,1)
8375 cd derx(lll,kkk,iii)=0.0d0
8379 cd gcorr_loc(l-1)=0.0d0
8380 cd gcorr_loc(j-1)=0.0d0
8381 cd gcorr_loc(k-1)=0.0d0
8383 cd write (iout,*)'Contacts have occurred for peptide groups',
8384 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8385 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8386 if (j.lt.nres-1) then
8393 if (l.lt.nres-1) then
8401 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8402 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8403 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8404 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8405 cgrad ghalf=0.5d0*ggg1(ll)
8406 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8407 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8408 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8409 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8410 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8411 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8412 cgrad ghalf=0.5d0*ggg2(ll)
8413 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8414 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8415 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8416 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8417 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8418 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8422 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8427 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8432 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8437 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8441 cd write (2,*) iii,gcorr_loc(iii)
8444 cd write (2,*) 'ekont',ekont
8445 cd write (iout,*) 'eello4',ekont*eel4
8448 C---------------------------------------------------------------------------
8449 double precision function eello5(i,j,k,l,jj,kk)
8450 implicit real*8 (a-h,o-z)
8451 include 'DIMENSIONS'
8452 include 'COMMON.IOUNITS'
8453 include 'COMMON.CHAIN'
8454 include 'COMMON.DERIV'
8455 include 'COMMON.INTERACT'
8456 include 'COMMON.CONTACTS'
8457 include 'COMMON.TORSION'
8458 include 'COMMON.VAR'
8459 include 'COMMON.GEO'
8460 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8461 double precision ggg1(3),ggg2(3)
8462 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8467 C /l\ / \ \ / \ / \ / C
8468 C / \ / \ \ / \ / \ / C
8469 C j| o |l1 | o | o| o | | o |o C
8470 C \ |/k\| |/ \| / |/ \| |/ \| C
8471 C \i/ \ / \ / / \ / \ C
8473 C (I) (II) (III) (IV) C
8475 C eello5_1 eello5_2 eello5_3 eello5_4 C
8477 C Antiparallel chains C
8480 C /j\ / \ \ / \ / \ / C
8481 C / \ / \ \ / \ / \ / C
8482 C j1| o |l | o | o| o | | o |o C
8483 C \ |/k\| |/ \| / |/ \| |/ \| C
8484 C \i/ \ / \ / / \ / \ C
8486 C (I) (II) (III) (IV) C
8488 C eello5_1 eello5_2 eello5_3 eello5_4 C
8490 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8492 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8493 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8498 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8500 itk=itortyp(itype(k))
8501 itl=itortyp(itype(l))
8502 itj=itortyp(itype(j))
8507 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8508 cd & eel5_3_num,eel5_4_num)
8512 derx(lll,kkk,iii)=0.0d0
8516 cd eij=facont_hb(jj,i)
8517 cd ekl=facont_hb(kk,k)
8519 cd write (iout,*)'Contacts have occurred for peptide groups',
8520 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8522 C Contribution from the graph I.
8523 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8524 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8525 call transpose2(EUg(1,1,k),auxmat(1,1))
8526 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8527 vv(1)=pizda(1,1)-pizda(2,2)
8528 vv(2)=pizda(1,2)+pizda(2,1)
8529 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8530 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8531 C Explicit gradient in virtual-dihedral angles.
8532 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8533 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8534 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8535 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8536 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8537 vv(1)=pizda(1,1)-pizda(2,2)
8538 vv(2)=pizda(1,2)+pizda(2,1)
8539 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8540 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8541 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8542 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8543 vv(1)=pizda(1,1)-pizda(2,2)
8544 vv(2)=pizda(1,2)+pizda(2,1)
8546 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8547 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8548 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8550 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8551 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8552 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8554 C Cartesian gradient
8558 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8560 vv(1)=pizda(1,1)-pizda(2,2)
8561 vv(2)=pizda(1,2)+pizda(2,1)
8562 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8563 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8564 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8570 C Contribution from graph II
8571 call transpose2(EE(1,1,itk),auxmat(1,1))
8572 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8573 vv(1)=pizda(1,1)+pizda(2,2)
8574 vv(2)=pizda(2,1)-pizda(1,2)
8575 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8576 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8577 C Explicit gradient in virtual-dihedral angles.
8578 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8579 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8580 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8581 vv(1)=pizda(1,1)+pizda(2,2)
8582 vv(2)=pizda(2,1)-pizda(1,2)
8584 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8585 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8586 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8588 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8589 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8590 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8592 C Cartesian gradient
8596 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8598 vv(1)=pizda(1,1)+pizda(2,2)
8599 vv(2)=pizda(2,1)-pizda(1,2)
8600 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8601 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8602 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8610 C Parallel orientation
8611 C Contribution from graph III
8612 call transpose2(EUg(1,1,l),auxmat(1,1))
8613 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8614 vv(1)=pizda(1,1)-pizda(2,2)
8615 vv(2)=pizda(1,2)+pizda(2,1)
8616 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8617 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8618 C Explicit gradient in virtual-dihedral angles.
8619 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8620 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8621 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8622 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8623 vv(1)=pizda(1,1)-pizda(2,2)
8624 vv(2)=pizda(1,2)+pizda(2,1)
8625 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8626 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8627 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8628 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8629 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8630 vv(1)=pizda(1,1)-pizda(2,2)
8631 vv(2)=pizda(1,2)+pizda(2,1)
8632 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8633 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8634 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8635 C Cartesian gradient
8639 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8641 vv(1)=pizda(1,1)-pizda(2,2)
8642 vv(2)=pizda(1,2)+pizda(2,1)
8643 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8644 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8645 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8650 C Contribution from graph IV
8652 call transpose2(EE(1,1,itl),auxmat(1,1))
8653 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8654 vv(1)=pizda(1,1)+pizda(2,2)
8655 vv(2)=pizda(2,1)-pizda(1,2)
8656 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8657 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8658 C Explicit gradient in virtual-dihedral angles.
8659 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8660 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8661 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8662 vv(1)=pizda(1,1)+pizda(2,2)
8663 vv(2)=pizda(2,1)-pizda(1,2)
8664 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8665 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8666 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8667 C Cartesian gradient
8671 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8673 vv(1)=pizda(1,1)+pizda(2,2)
8674 vv(2)=pizda(2,1)-pizda(1,2)
8675 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8676 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
8677 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8682 C Antiparallel orientation
8683 C Contribution from graph III
8685 call transpose2(EUg(1,1,j),auxmat(1,1))
8686 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8687 vv(1)=pizda(1,1)-pizda(2,2)
8688 vv(2)=pizda(1,2)+pizda(2,1)
8689 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8690 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8691 C Explicit gradient in virtual-dihedral angles.
8692 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8693 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8694 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8695 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8696 vv(1)=pizda(1,1)-pizda(2,2)
8697 vv(2)=pizda(1,2)+pizda(2,1)
8698 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8699 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8700 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8701 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8702 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8703 vv(1)=pizda(1,1)-pizda(2,2)
8704 vv(2)=pizda(1,2)+pizda(2,1)
8705 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8706 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8707 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8708 C Cartesian gradient
8712 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8714 vv(1)=pizda(1,1)-pizda(2,2)
8715 vv(2)=pizda(1,2)+pizda(2,1)
8716 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8717 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8718 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8723 C Contribution from graph IV
8725 call transpose2(EE(1,1,itj),auxmat(1,1))
8726 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8727 vv(1)=pizda(1,1)+pizda(2,2)
8728 vv(2)=pizda(2,1)-pizda(1,2)
8729 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
8730 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8731 C Explicit gradient in virtual-dihedral angles.
8732 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8733 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8734 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8735 vv(1)=pizda(1,1)+pizda(2,2)
8736 vv(2)=pizda(2,1)-pizda(1,2)
8737 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8738 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
8739 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8740 C Cartesian gradient
8744 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8746 vv(1)=pizda(1,1)+pizda(2,2)
8747 vv(2)=pizda(2,1)-pizda(1,2)
8748 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8749 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
8750 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8756 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8757 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8758 cd write (2,*) 'ijkl',i,j,k,l
8759 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8760 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8762 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8763 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8764 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8765 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8766 if (j.lt.nres-1) then
8773 if (l.lt.nres-1) then
8783 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8784 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8785 C summed up outside the subrouine as for the other subroutines
8786 C handling long-range interactions. The old code is commented out
8787 C with "cgrad" to keep track of changes.
8789 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8790 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8791 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8792 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8793 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8794 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8795 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8796 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8797 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8798 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8800 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8801 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8802 cgrad ghalf=0.5d0*ggg1(ll)
8804 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8805 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8806 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8807 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8808 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8809 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8810 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8811 cgrad ghalf=0.5d0*ggg2(ll)
8813 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8814 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8815 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8816 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8817 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8818 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8823 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8824 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8829 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8830 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8836 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8841 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8845 cd write (2,*) iii,g_corr5_loc(iii)
8848 cd write (2,*) 'ekont',ekont
8849 cd write (iout,*) 'eello5',ekont*eel5
8852 c--------------------------------------------------------------------------
8853 double precision function eello6(i,j,k,l,jj,kk)
8854 implicit real*8 (a-h,o-z)
8855 include 'DIMENSIONS'
8856 include 'COMMON.IOUNITS'
8857 include 'COMMON.CHAIN'
8858 include 'COMMON.DERIV'
8859 include 'COMMON.INTERACT'
8860 include 'COMMON.CONTACTS'
8861 include 'COMMON.TORSION'
8862 include 'COMMON.VAR'
8863 include 'COMMON.GEO'
8864 include 'COMMON.FFIELD'
8865 double precision ggg1(3),ggg2(3)
8866 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8871 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8879 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8880 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8884 derx(lll,kkk,iii)=0.0d0
8888 cd eij=facont_hb(jj,i)
8889 cd ekl=facont_hb(kk,k)
8895 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8896 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8897 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8898 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8899 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8900 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8902 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8903 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8904 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8905 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8906 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8907 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8911 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8913 C If turn contributions are considered, they will be handled separately.
8914 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8915 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8916 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8917 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8918 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8919 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8920 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8922 if (j.lt.nres-1) then
8929 if (l.lt.nres-1) then
8937 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8938 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8939 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8940 cgrad ghalf=0.5d0*ggg1(ll)
8942 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8943 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8944 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8945 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8946 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8947 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8948 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8949 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8950 cgrad ghalf=0.5d0*ggg2(ll)
8951 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8953 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8954 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8955 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8956 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8957 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8958 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8963 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8964 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8969 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8970 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8976 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8981 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8985 cd write (2,*) iii,g_corr6_loc(iii)
8988 cd write (2,*) 'ekont',ekont
8989 cd write (iout,*) 'eello6',ekont*eel6
8992 c--------------------------------------------------------------------------
8993 double precision function eello6_graph1(i,j,k,l,imat,swap)
8994 implicit real*8 (a-h,o-z)
8995 include 'DIMENSIONS'
8996 include 'COMMON.IOUNITS'
8997 include 'COMMON.CHAIN'
8998 include 'COMMON.DERIV'
8999 include 'COMMON.INTERACT'
9000 include 'COMMON.CONTACTS'
9001 include 'COMMON.TORSION'
9002 include 'COMMON.VAR'
9003 include 'COMMON.GEO'
9004 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9008 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9010 C Parallel Antiparallel C
9016 C \ j|/k\| / \ |/k\|l / C
9021 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9022 itk=itortyp(itype(k))
9023 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9024 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9025 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9026 call transpose2(EUgC(1,1,k),auxmat(1,1))
9027 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9028 vv1(1)=pizda1(1,1)-pizda1(2,2)
9029 vv1(2)=pizda1(1,2)+pizda1(2,1)
9030 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9031 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
9032 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
9033 s5=scalar2(vv(1),Dtobr2(1,i))
9034 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9035 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9036 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9037 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9038 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9039 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9040 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9041 & +scalar2(vv(1),Dtobr2der(1,i)))
9042 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9043 vv1(1)=pizda1(1,1)-pizda1(2,2)
9044 vv1(2)=pizda1(1,2)+pizda1(2,1)
9045 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
9046 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
9048 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9049 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9050 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9051 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9052 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9054 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9055 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9056 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9057 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9058 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9060 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9061 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9062 vv1(1)=pizda1(1,1)-pizda1(2,2)
9063 vv1(2)=pizda1(1,2)+pizda1(2,1)
9064 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9065 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9066 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
9067 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9076 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9077 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9078 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9079 call transpose2(EUgC(1,1,k),auxmat(1,1))
9080 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9082 vv1(1)=pizda1(1,1)-pizda1(2,2)
9083 vv1(2)=pizda1(1,2)+pizda1(2,1)
9084 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9085 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
9086 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
9087 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
9088 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
9089 s5=scalar2(vv(1),Dtobr2(1,i))
9090 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9096 c----------------------------------------------------------------------------
9097 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
9098 implicit real*8 (a-h,o-z)
9099 include 'DIMENSIONS'
9100 include 'COMMON.IOUNITS'
9101 include 'COMMON.CHAIN'
9102 include 'COMMON.DERIV'
9103 include 'COMMON.INTERACT'
9104 include 'COMMON.CONTACTS'
9105 include 'COMMON.TORSION'
9106 include 'COMMON.VAR'
9107 include 'COMMON.GEO'
9109 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9110 & auxvec1(2),auxvec2(2),auxmat1(2,2)
9113 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9115 C Parallel Antiparallel C
9121 C \ j|/k\| \ |/k\|l C
9126 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9127 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9128 C AL 7/4/01 s1 would occur in the sixth-order moment,
9129 C but not in a cluster cumulant
9131 s1=dip(1,jj,i)*dip(1,kk,k)
9133 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9134 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9135 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9136 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9137 call transpose2(EUg(1,1,k),auxmat(1,1))
9138 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9139 vv(1)=pizda(1,1)-pizda(2,2)
9140 vv(2)=pizda(1,2)+pizda(2,1)
9141 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9142 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9144 eello6_graph2=-(s1+s2+s3+s4)
9146 eello6_graph2=-(s2+s3+s4)
9149 C Derivatives in gamma(i-1)
9152 s1=dipderg(1,jj,i)*dip(1,kk,k)
9154 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9155 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9156 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9157 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9159 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9161 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9163 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9165 C Derivatives in gamma(k-1)
9167 s1=dip(1,jj,i)*dipderg(1,kk,k)
9169 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9170 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9171 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9172 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9173 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9174 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9175 vv(1)=pizda(1,1)-pizda(2,2)
9176 vv(2)=pizda(1,2)+pizda(2,1)
9177 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9179 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9181 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9183 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9184 C Derivatives in gamma(j-1) or gamma(l-1)
9187 s1=dipderg(3,jj,i)*dip(1,kk,k)
9189 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9190 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9191 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9192 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9193 vv(1)=pizda(1,1)-pizda(2,2)
9194 vv(2)=pizda(1,2)+pizda(2,1)
9195 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9198 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9200 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9203 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9204 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9206 C Derivatives in gamma(l-1) or gamma(j-1)
9209 s1=dip(1,jj,i)*dipderg(3,kk,k)
9211 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9212 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9213 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9214 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9215 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9216 vv(1)=pizda(1,1)-pizda(2,2)
9217 vv(2)=pizda(1,2)+pizda(2,1)
9218 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9221 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9223 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9226 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9227 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9229 C Cartesian derivatives.
9231 write (2,*) 'In eello6_graph2'
9233 write (2,*) 'iii=',iii
9235 write (2,*) 'kkk=',kkk
9237 write (2,'(3(2f10.5),5x)')
9238 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9248 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9250 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9253 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9255 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9256 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9258 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9259 call transpose2(EUg(1,1,k),auxmat(1,1))
9260 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9262 vv(1)=pizda(1,1)-pizda(2,2)
9263 vv(2)=pizda(1,2)+pizda(2,1)
9264 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9265 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9267 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9269 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9272 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9274 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9281 c----------------------------------------------------------------------------
9282 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9283 implicit real*8 (a-h,o-z)
9284 include 'DIMENSIONS'
9285 include 'COMMON.IOUNITS'
9286 include 'COMMON.CHAIN'
9287 include 'COMMON.DERIV'
9288 include 'COMMON.INTERACT'
9289 include 'COMMON.CONTACTS'
9290 include 'COMMON.TORSION'
9291 include 'COMMON.VAR'
9292 include 'COMMON.GEO'
9293 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9295 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9297 C Parallel Antiparallel C
9303 C j|/k\| / |/k\|l / C
9308 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9310 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9311 C energy moment and not to the cluster cumulant.
9312 iti=itortyp(itype(i))
9313 if (j.lt.nres-1) then
9314 itj1=itortyp(itype(j+1))
9318 itk=itortyp(itype(k))
9319 itk1=itortyp(itype(k+1))
9320 if (l.lt.nres-1) then
9321 itl1=itortyp(itype(l+1))
9326 s1=dip(4,jj,i)*dip(4,kk,k)
9328 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
9329 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9330 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
9331 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9332 call transpose2(EE(1,1,itk),auxmat(1,1))
9333 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9334 vv(1)=pizda(1,1)+pizda(2,2)
9335 vv(2)=pizda(2,1)-pizda(1,2)
9336 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9337 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9338 cd & "sum",-(s2+s3+s4)
9340 eello6_graph3=-(s1+s2+s3+s4)
9342 eello6_graph3=-(s2+s3+s4)
9345 C Derivatives in gamma(k-1)
9346 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
9347 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9348 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9349 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9350 C Derivatives in gamma(l-1)
9351 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
9352 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9353 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9354 vv(1)=pizda(1,1)+pizda(2,2)
9355 vv(2)=pizda(2,1)-pizda(1,2)
9356 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9357 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9358 C Cartesian derivatives.
9364 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9366 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9369 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9371 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9372 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9374 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9375 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9377 vv(1)=pizda(1,1)+pizda(2,2)
9378 vv(2)=pizda(2,1)-pizda(1,2)
9379 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9381 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9383 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9386 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9388 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9390 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9396 c----------------------------------------------------------------------------
9397 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9398 implicit real*8 (a-h,o-z)
9399 include 'DIMENSIONS'
9400 include 'COMMON.IOUNITS'
9401 include 'COMMON.CHAIN'
9402 include 'COMMON.DERIV'
9403 include 'COMMON.INTERACT'
9404 include 'COMMON.CONTACTS'
9405 include 'COMMON.TORSION'
9406 include 'COMMON.VAR'
9407 include 'COMMON.GEO'
9408 include 'COMMON.FFIELD'
9409 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9410 & auxvec1(2),auxmat1(2,2)
9412 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9414 C Parallel Antiparallel C
9420 C \ j|/k\| \ |/k\|l C
9425 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9427 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9428 C energy moment and not to the cluster cumulant.
9429 cd write (2,*) 'eello_graph4: wturn6',wturn6
9430 iti=itortyp(itype(i))
9431 itj=itortyp(itype(j))
9432 if (j.lt.nres-1) then
9433 itj1=itortyp(itype(j+1))
9437 itk=itortyp(itype(k))
9438 if (k.lt.nres-1) then
9439 itk1=itortyp(itype(k+1))
9443 itl=itortyp(itype(l))
9444 if (l.lt.nres-1) then
9445 itl1=itortyp(itype(l+1))
9449 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9450 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9451 cd & ' itl',itl,' itl1',itl1
9454 s1=dip(3,jj,i)*dip(3,kk,k)
9456 s1=dip(2,jj,j)*dip(2,kk,l)
9459 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9460 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9462 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9463 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9465 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9466 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9468 call transpose2(EUg(1,1,k),auxmat(1,1))
9469 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9470 vv(1)=pizda(1,1)-pizda(2,2)
9471 vv(2)=pizda(2,1)+pizda(1,2)
9472 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9473 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9475 eello6_graph4=-(s1+s2+s3+s4)
9477 eello6_graph4=-(s2+s3+s4)
9479 C Derivatives in gamma(i-1)
9483 s1=dipderg(2,jj,i)*dip(3,kk,k)
9485 s1=dipderg(4,jj,j)*dip(2,kk,l)
9488 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9490 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9491 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9493 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9494 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9496 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9497 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9498 cd write (2,*) 'turn6 derivatives'
9500 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9502 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9506 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9508 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9512 C Derivatives in gamma(k-1)
9515 s1=dip(3,jj,i)*dipderg(2,kk,k)
9517 s1=dip(2,jj,j)*dipderg(4,kk,l)
9520 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9521 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9523 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9524 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9526 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9527 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9529 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9530 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9531 vv(1)=pizda(1,1)-pizda(2,2)
9532 vv(2)=pizda(2,1)+pizda(1,2)
9533 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9534 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9536 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9538 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9542 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9544 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9547 C Derivatives in gamma(j-1) or gamma(l-1)
9548 if (l.eq.j+1 .and. l.gt.1) then
9549 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9550 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9551 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9552 vv(1)=pizda(1,1)-pizda(2,2)
9553 vv(2)=pizda(2,1)+pizda(1,2)
9554 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9555 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9556 else if (j.gt.1) then
9557 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9558 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9559 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9560 vv(1)=pizda(1,1)-pizda(2,2)
9561 vv(2)=pizda(2,1)+pizda(1,2)
9562 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9563 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9564 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9566 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9569 C Cartesian derivatives.
9576 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9578 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9582 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9584 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9588 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9590 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9592 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9593 & b1(1,j+1),auxvec(1))
9594 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9596 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9597 & b1(1,l+1),auxvec(1))
9598 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9600 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(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))
9606 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9608 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9611 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9614 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9617 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9619 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9621 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9625 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9627 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9630 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9632 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9640 c----------------------------------------------------------------------------
9641 double precision function eello_turn6(i,jj,kk)
9642 implicit real*8 (a-h,o-z)
9643 include 'DIMENSIONS'
9644 include 'COMMON.IOUNITS'
9645 include 'COMMON.CHAIN'
9646 include 'COMMON.DERIV'
9647 include 'COMMON.INTERACT'
9648 include 'COMMON.CONTACTS'
9649 include 'COMMON.TORSION'
9650 include 'COMMON.VAR'
9651 include 'COMMON.GEO'
9652 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9653 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9655 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9656 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9657 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9658 C the respective energy moment and not to the cluster cumulant.
9667 iti=itortyp(itype(i))
9668 itk=itortyp(itype(k))
9669 itk1=itortyp(itype(k+1))
9670 itl=itortyp(itype(l))
9671 itj=itortyp(itype(j))
9672 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9673 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9674 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9679 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9681 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9685 derx_turn(lll,kkk,iii)=0.0d0
9692 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9694 cd write (2,*) 'eello6_5',eello6_5
9696 call transpose2(AEA(1,1,1),auxmat(1,1))
9697 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9698 ss1=scalar2(Ub2(1,i+2),b1(1,l))
9699 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9701 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9702 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9703 s2 = scalar2(b1(1,k),vtemp1(1))
9705 call transpose2(AEA(1,1,2),atemp(1,1))
9706 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9707 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9708 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9710 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9711 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9712 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9714 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9715 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9716 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9717 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9718 ss13 = scalar2(b1(1,k),vtemp4(1))
9719 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9721 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9727 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9728 C Derivatives in gamma(i+2)
9732 call transpose2(AEA(1,1,1),auxmatd(1,1))
9733 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9734 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9735 call transpose2(AEAderg(1,1,2),atempd(1,1))
9736 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9737 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9739 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9740 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9741 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9747 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9748 C Derivatives in gamma(i+3)
9750 call transpose2(AEA(1,1,1),auxmatd(1,1))
9751 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9752 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
9753 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9755 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
9756 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9757 s2d = scalar2(b1(1,k),vtemp1d(1))
9759 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9760 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9762 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9764 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9765 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9766 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9774 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9775 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9777 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9778 & -0.5d0*ekont*(s2d+s12d)
9780 C Derivatives in gamma(i+4)
9781 call matmat2(EUgder(1,1,i+3),AEA(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))
9785 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9786 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9787 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9795 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9797 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9799 C Derivatives in gamma(i+5)
9801 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9802 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9803 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9805 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
9806 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9807 s2d = scalar2(b1(1,k),vtemp1d(1))
9809 call transpose2(AEA(1,1,2),atempd(1,1))
9810 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9811 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9813 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9814 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9816 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9817 ss13d = scalar2(b1(1,k),vtemp4d(1))
9818 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9826 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9827 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9829 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9830 & -0.5d0*ekont*(s2d+s12d)
9832 C Cartesian derivatives
9837 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9838 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9839 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9841 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9842 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9844 s2d = scalar2(b1(1,k),vtemp1d(1))
9846 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9847 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9848 s8d = -(atempd(1,1)+atempd(2,2))*
9849 & scalar2(cc(1,1,itl),vtemp2(1))
9851 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9853 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9854 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9861 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9864 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9868 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9869 & - 0.5d0*(s8d+s12d)
9871 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9880 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9882 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9883 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9884 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9885 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9886 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9888 ss13d = scalar2(b1(1,k),vtemp4d(1))
9889 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9890 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9894 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9895 cd & 16*eel_turn6_num
9897 if (j.lt.nres-1) then
9904 if (l.lt.nres-1) then
9912 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9913 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9914 cgrad ghalf=0.5d0*ggg1(ll)
9916 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9917 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9918 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9919 & +ekont*derx_turn(ll,2,1)
9920 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9921 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9922 & +ekont*derx_turn(ll,4,1)
9923 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9924 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9925 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9926 cgrad ghalf=0.5d0*ggg2(ll)
9928 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9929 & +ekont*derx_turn(ll,2,2)
9930 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9931 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9932 & +ekont*derx_turn(ll,4,2)
9933 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9934 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9935 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9940 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9945 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9951 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9956 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9960 cd write (2,*) iii,g_corr6_loc(iii)
9962 eello_turn6=ekont*eel_turn6
9963 cd write (2,*) 'ekont',ekont
9964 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9968 C-----------------------------------------------------------------------------
9969 double precision function scalar(u,v)
9970 !DIR$ INLINEALWAYS scalar
9972 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9975 double precision u(3),v(3)
9976 cd double precision sc
9984 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9987 crc-------------------------------------------------
9988 SUBROUTINE MATVEC2(A1,V1,V2)
9989 !DIR$ INLINEALWAYS MATVEC2
9991 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9993 implicit real*8 (a-h,o-z)
9994 include 'DIMENSIONS'
9995 DIMENSION A1(2,2),V1(2),V2(2)
9999 c 3 VI=VI+A1(I,K)*V1(K)
10003 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10004 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10009 C---------------------------------------
10010 SUBROUTINE MATMAT2(A1,A2,A3)
10012 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10014 implicit real*8 (a-h,o-z)
10015 include 'DIMENSIONS'
10016 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10017 c DIMENSION AI3(2,2)
10021 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10027 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10028 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10029 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10030 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10038 c-------------------------------------------------------------------------
10039 double precision function scalar2(u,v)
10040 !DIR$ INLINEALWAYS scalar2
10042 double precision u(2),v(2)
10043 double precision sc
10045 scalar2=u(1)*v(1)+u(2)*v(2)
10049 C-----------------------------------------------------------------------------
10051 subroutine transpose2(a,at)
10052 !DIR$ INLINEALWAYS transpose2
10054 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
10057 double precision a(2,2),at(2,2)
10064 c--------------------------------------------------------------------------
10065 subroutine transpose(n,a,at)
10068 double precision a(n,n),at(n,n)
10076 C---------------------------------------------------------------------------
10077 subroutine prodmat3(a1,a2,kk,transp,prod)
10078 !DIR$ INLINEALWAYS prodmat3
10080 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
10084 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
10086 crc double precision auxmat(2,2),prod_(2,2)
10089 crc call transpose2(kk(1,1),auxmat(1,1))
10090 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10091 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10093 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
10094 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10095 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
10096 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10097 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
10098 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10099 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
10100 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10103 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10104 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10106 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
10107 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10108 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
10109 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10110 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
10111 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10112 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
10113 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10116 c call transpose2(a2(1,1),a2t(1,1))
10119 crc print *,((prod_(i,j),i=1,2),j=1,2)
10120 crc print *,((prod(i,j),i=1,2),j=1,2)
10124 CCC----------------------------------------------
10125 subroutine Eliptransfer(eliptran)
10126 implicit real*8 (a-h,o-z)
10127 include 'DIMENSIONS'
10128 include 'COMMON.GEO'
10129 include 'COMMON.VAR'
10130 include 'COMMON.LOCAL'
10131 include 'COMMON.CHAIN'
10132 include 'COMMON.DERIV'
10133 include 'COMMON.NAMES'
10134 include 'COMMON.INTERACT'
10135 include 'COMMON.IOUNITS'
10136 include 'COMMON.CALC'
10137 include 'COMMON.CONTROL'
10138 include 'COMMON.SPLITELE'
10139 include 'COMMON.SBRIDGE'
10140 C this is done by Adasko
10141 C print *,"wchodze"
10142 C structure of box:
10144 C--bordliptop-- buffore starts
10145 C--bufliptop--- here true lipid starts
10147 C--buflipbot--- lipid ends buffore starts
10148 C--bordlipbot--buffore ends
10150 do i=ilip_start,ilip_end
10152 if (itype(i).eq.ntyp1) cycle
10154 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
10155 if (positi.le.0) positi=positi+boxzsize
10157 C first for peptide groups
10158 c for each residue check if it is in lipid or lipid water border area
10159 if ((positi.gt.bordlipbot)
10160 &.and.(positi.lt.bordliptop)) then
10161 C the energy transfer exist
10162 if (positi.lt.buflipbot) then
10163 C what fraction I am in
10165 & ((positi-bordlipbot)/lipbufthick)
10166 C lipbufthick is thickenes of lipid buffore
10167 sslip=sscalelip(fracinbuf)
10168 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10169 eliptran=eliptran+sslip*pepliptran
10170 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10171 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10172 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10174 C print *,"doing sccale for lower part"
10175 C print *,i,sslip,fracinbuf,ssgradlip
10176 elseif (positi.gt.bufliptop) then
10177 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
10178 sslip=sscalelip(fracinbuf)
10179 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10180 eliptran=eliptran+sslip*pepliptran
10181 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10182 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10183 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10184 C print *, "doing sscalefor top part"
10185 C print *,i,sslip,fracinbuf,ssgradlip
10187 eliptran=eliptran+pepliptran
10188 C print *,"I am in true lipid"
10191 C eliptran=elpitran+0.0 ! I am in water
10194 C print *, "nic nie bylo w lipidzie?"
10195 C now multiply all by the peptide group transfer factor
10196 C eliptran=eliptran*pepliptran
10197 C now the same for side chains
10199 do i=ilip_start,ilip_end
10200 if (itype(i).eq.ntyp1) cycle
10201 positi=(mod(c(3,i+nres),boxzsize))
10202 if (positi.le.0) positi=positi+boxzsize
10203 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
10204 c for each residue check if it is in lipid or lipid water border area
10205 C respos=mod(c(3,i+nres),boxzsize)
10206 C print *,positi,bordlipbot,buflipbot
10207 if ((positi.gt.bordlipbot)
10208 & .and.(positi.lt.bordliptop)) then
10209 C the energy transfer exist
10210 if (positi.lt.buflipbot) then
10212 & ((positi-bordlipbot)/lipbufthick)
10213 C lipbufthick is thickenes of lipid buffore
10214 sslip=sscalelip(fracinbuf)
10215 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10216 eliptran=eliptran+sslip*liptranene(itype(i))
10217 gliptranx(3,i)=gliptranx(3,i)
10218 &+ssgradlip*liptranene(itype(i))
10219 gliptranc(3,i-1)= gliptranc(3,i-1)
10220 &+ssgradlip*liptranene(itype(i))
10221 C print *,"doing sccale for lower part"
10222 elseif (positi.gt.bufliptop) then
10224 &((bordliptop-positi)/lipbufthick)
10225 sslip=sscalelip(fracinbuf)
10226 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10227 eliptran=eliptran+sslip*liptranene(itype(i))
10228 gliptranx(3,i)=gliptranx(3,i)
10229 &+ssgradlip*liptranene(itype(i))
10230 gliptranc(3,i-1)= gliptranc(3,i-1)
10231 &+ssgradlip*liptranene(itype(i))
10232 C print *, "doing sscalefor top part",sslip,fracinbuf
10234 eliptran=eliptran+liptranene(itype(i))
10235 C print *,"I am in true lipid"
10237 endif ! if in lipid or buffor
10239 C eliptran=elpitran+0.0 ! I am in water
10243 C---------------------------------------------------------
10244 C AFM soubroutine for constant force
10245 subroutine AFMforce(Eafmforce)
10246 implicit real*8 (a-h,o-z)
10247 include 'DIMENSIONS'
10248 include 'COMMON.GEO'
10249 include 'COMMON.VAR'
10250 include 'COMMON.LOCAL'
10251 include 'COMMON.CHAIN'
10252 include 'COMMON.DERIV'
10253 include 'COMMON.NAMES'
10254 include 'COMMON.INTERACT'
10255 include 'COMMON.IOUNITS'
10256 include 'COMMON.CALC'
10257 include 'COMMON.CONTROL'
10258 include 'COMMON.SPLITELE'
10259 include 'COMMON.SBRIDGE'
10264 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10265 dist=dist+diffafm(i)**2
10268 Eafmforce=-forceAFMconst*(dist-distafminit)
10270 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
10271 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
10273 C print *,'AFM',Eafmforce