! $Id$
!
! MODULE_DOC: This module takes care of most of the things related to velocity.
! MODULE_DOC: Pressure, for example, is added in the energy (entropy) module.
!
!** AUTOMATIC CPARAM.INC GENERATION ****************************
! Declare (for generation of cparam.inc) the number of f array
! variables and auxiliary variables added by this module
!
! CPARAM logical, parameter :: lhydro = .true.
! CPARAM logical, parameter :: lhydro_kinematic = .false.
!
! MVAR CONTRIBUTION 3
! MAUX CONTRIBUTION 0
!
! PENCILS PROVIDED divu; oo(3); o2; ou; oxu2; oxu(3); u2; uij(3,3); uu(3); curlo(3)
! PENCILS PROVIDED sij(3,3); sij2; uij5(3,3); ugu(3); ugu2; oij(3,3)
! PENCILS PROVIDED d2uidxj(3,3), uijk(3,3,3); ogu(3)
! PENCILS PROVIDED u3u21; u1u32; u2u13; del2u(3); del4u(3); del6u(3)
! PENCILS PROVIDED u2u31; u3u12; u1u23
! PENCILS PROVIDED graddivu(3); del6u_bulk(3); grad5divu(3)
! PENCILS PROVIDED rhougu(3); der6u(3); transpurho(3)
! PENCILS PROVIDED divu0; u0ij(3,3); uu0(3)
! PENCILS PROVIDED uu_advec(3); uuadvec_guu(3)
! PENCILS PROVIDED del6u_strict(3); del4graddivu(3); uu_sph(3)
! PENCILS PROVIDED der6u_res(3,3)
!***************************************************************
!
module Hydro
!
  use Cparam
  use Cdata
  use General, only: keep_compiler_quiet
  use Messages
  use Viscosity, only: calc_viscous_force
  use SGS_hydro
!
  implicit none
!
  include 'hydro.h'
!
!  Slice precalculation buffers.
!
  real, target, dimension (:,:,:), allocatable :: oo_xy,oo_xy2,oo_xy3,oo_xy4
  real, target, dimension (:,:,:), allocatable :: oo_xz,oo_yz,oo_xz2
  real, target, dimension (:,:,:), allocatable :: uu_sph_xy,uu_sph_xy2,uu_sph_xy3,uu_sph_xy4
  real, target, dimension (:,:,:), allocatable :: uu_sph_xz,uu_sph_yz,uu_sph_xz2
  real, target, dimension (:,:), allocatable :: divu_xy,u2_xy,o2_xy,mach_xy
  real, target, dimension (:,:), allocatable :: divu_xy2,u2_xy2,o2_xy2,mach_xy2
  real, target, dimension (:,:), allocatable :: divu_xy3,divu_xy4,u2_xy3,u2_xy4,mach_xy4
  real, target, dimension (:,:), allocatable :: o2_xy3,o2_xy4,mach_xy3
  real, target, dimension (:,:), allocatable :: divu_xz,u2_xz,o2_xz,mach_xz
  real, target, dimension (:,:), allocatable :: divu_xz2,u2_xz2,o2_xz2,mach_xz2
  real, target, dimension (:,:), allocatable :: divu_yz,u2_yz,o2_yz,mach_yz
  real, target, dimension (:,:), allocatable :: ou_xy,ou_xy2,ou_xy3,ou_xy4
  real, target, dimension (:,:), allocatable :: ou_xz,ou_yz,ou_xz2
  real, target, dimension (:,:,:,:,:), allocatable :: divu_r,u2_r,o2_r,mach_r,ou_r
  real, target, dimension (:,:,:,:,:,:), allocatable :: oo_r,uu_sph_r

  real, dimension (mz,3) :: uumz=0.0, ruumz=0.0
  real, dimension (mx,3) :: uumx=0.0
  real, dimension (my,3) :: uumy=0.0
  real, dimension (:,:,:), allocatable :: uumxy, ruumxy
  real, dimension (mx,mz,3) :: uumxz=0.0
!
!  phi-averaged arrays for orbital advection
!
  real, dimension (mx,mz) :: uu_average_cyl=0.
  real, dimension (mx,my) :: uu_average_sph=0.
!
!  Cosine and sine function for setting test fields and analysis.
!
  real, dimension (mz) :: c2z,s2z,cz,sz
!
!  Profiles for setting differential rotation
!  (analogously to hydro_kinematic.f90).
!
  real, dimension(nx) :: profx_diffrot1=1., profx_diffrot2=1., profx_diffrot3=1.
  real, dimension(my) :: profy_diffrot1=1., profy_diffrot2=1., profy_diffrot3=1.
  real, dimension(mz) :: profz_diffrot1=1.
!
!  Precession matrices.
!
  real, dimension (3,3) :: mat_cori=0.,mat_cent=0.
!
!  Init parameters.
!
  real :: widthuu=.1, radiusuu=1., urand=0., kx_uu=1., ky_uu=1., kz_uu=1.
  real :: relhel_uu=1.,urandi=0.
  real :: uu_left=0.,uu_right=0.,uu_lower=1.,uu_upper=1.
  real :: uy_left=0.,uy_right=0.
  real :: initpower=1.,initpower2=-5./3.,cutoff=0.,ncutoff=1., kpeak=10.
  real :: xhalf, kgaussian_uu=0., nfact_uu=4.
  real, dimension (ninit) :: ampl_ux=0.0, ampl_uy=0.0, ampl_uz=0.0
  real, dimension (ninit) :: kx_ux=0.0, kx_uy=0.0, kx_uz=0.0
  real, dimension (ninit) :: ky_ux=0.0, ky_uy=0.0, ky_uz=0.0
  real, dimension (ninit) :: kz_ux=0.0, kz_uy=0.0, kz_uz=0.0
  real, dimension (ninit) :: phase_ux=0.0, phase_uy=0.0, phase_uz=0.0
  real :: omega_precession=0., alpha_precession=0.
  real, dimension (ninit) :: ampluu=0.0, uu_xz_angle=0.0
  character (len=labellen), dimension(ninit) :: inituu='nothing'
  character (len=labellen), dimension(3) :: borderuu='nothing'
  real, dimension (3) :: uu_const=(/0.,0.,0./), mean_momentum=(/0.,0.,0./)
  complex, dimension (3) :: coefuu=(/0.,0.,0./)
  real, dimension(nx) :: xmask_hyd, cx10, sx10
  real, dimension(nz) :: zmask_hyd
  real, dimension(nx) :: prof_om
  real, dimension(2) :: hydro_xaver_range=(/-max_real,max_real/)
  real, dimension(2) :: hydro_zaver_range=(/-max_real,max_real/)
  real :: u_out_kep=0.0, velocity_ceiling=.0, w_sldchar_hyd=1.0
  real :: mu_omega=0., gap=0., r_omega=0., w_omega=0.
  real :: z1_uu=0., z2_uu=0.
  real :: ABC_A=1., ABC_B=1., ABC_C=1.
  integer :: nb_rings=0
  integer :: neddy=0
  integer :: iTij=0, ilorentz=0
!
! variables for expansion into spherical harmonics
!
  integer,parameter :: lSH_max=2
  integer, parameter :: Nmodes_SH=(lSH_max+1)*(lSH_max+1)
  integer :: index_rSH=1   !ceiling(nx/2.)
  real, dimension(nx) :: profile_SH=0.
!
  real, dimension (5) :: om_rings=0.
  integer :: N_modes_uu=0
  logical :: llinearized_hydro=.false.
  logical :: ladvection_velocity=.true.
  logical :: lprecession=.false.
  logical :: lshear_rateofstrain=.false.
  logical :: loo_as_aux = .false., llorentz_as_aux = .false.
  logical :: luut_as_aux=.false., luust_as_aux=.false.
  logical :: loot_as_aux=.false., loost_as_aux=.false.
  logical :: luuk_as_aux=.false., look_as_aux=.false.
  logical :: luu_fluc_as_aux=.false.
  logical :: luu_sph_as_aux=.false.
  logical :: lscale_tobox=.true.
  logical :: lfactors_uu=.false.
  logical, target :: lpressuregradient_gas=.true.
  logical :: lcoriolis_force=.true.
  logical :: lshear_in_coriolis=.false.
  logical :: lcentrifugal_force=.false.
  logical, pointer :: lffree
  logical :: lreflecteddy=.false.,louinit=.false.
  logical :: lskip_projection=.false.
  logical :: lconservative=.false., lrelativistic=.false.
  logical, pointer :: lrelativistic_eos
  logical :: lno_noise_uu=.false.
  logical :: llorentz_limiter=.false.
  real, pointer :: profx_ffree(:),profy_ffree(:),profz_ffree(:)
  real, pointer :: B_ext2
  real :: incl_alpha = 0.0, rot_rr = 0.0
  real :: xsphere = 0.0, ysphere = 0.0, zsphere = 0.0
  real :: amp_meri_circ = 0.0
  real :: max_uu = 0., delta_u=1
! The following is useful to debug the forcing - Dhruba
  real :: outest
  real :: ampl_Omega=0.0
  real :: omega_ini=0.0
  logical :: loutest, ldiffrot_test=.false.
  real :: r_cyl = 1.0, skin_depth = 1e-1
  real :: rnoise_int=impossible,rnoise_ext=impossible
  real :: PrRa  !preliminary
  real :: amp_factor=0.,kx_uu_perturb=0.
  real :: qirro_uu=0.
  integer, dimension(ninit) :: ll_sh=0, mm_sh=0, n_xprof=-1
!
  namelist /hydro_init_pars/ &
      ampluu, ampl_ux, ampl_uy, ampl_uz, phase_ux, phase_uy, phase_uz, &
      inituu, widthuu, radiusuu, urand, urandi, lpressuregradient_gas, &
      uu_xz_angle, relhel_uu, coefuu, r_omega, w_omega,&
      uu_left, uu_right, uu_lower, uu_upper, kx_uu, ky_uu, kz_uu, &
      kx_ux, ky_ux, kz_ux, kx_uy, ky_uy, kz_uy, kx_uz, ky_uz, kz_uz, &
      uy_left, uy_right, uu_const, Omega, u_out_kep, &
      initpower, initpower2, cutoff, ncutoff, kpeak, kgaussian_uu, &
      lconservative, lrelativistic, lskip_projection, z1_uu, z2_uu, &
      N_modes_uu, lcoriolis_force, lcentrifugal_force, ladvection_velocity, &
      lprecession, omega_precession, alpha_precession, velocity_ceiling, &
      loo_as_aux, luut_as_aux, luust_as_aux, loot_as_aux, loost_as_aux, &
      llorentz_as_aux, luuk_as_aux, look_as_aux, &
      mu_omega, nb_rings, om_rings, gap, &
      lscale_tobox, ampl_Omega, omega_ini, r_cyl, skin_depth, incl_alpha, &
      rot_rr, xsphere, ysphere, zsphere, neddy, amp_meri_circ, &
      rnoise_int, rnoise_ext, lreflecteddy, louinit, hydro_xaver_range, max_uu,&
      amp_factor,kx_uu_perturb,llinearized_hydro, hydro_zaver_range, index_rSH, &
      ll_sh, mm_sh, delta_u, n_xprof, luu_fluc_as_aux, luu_sph_as_aux, nfact_uu, &
      lfactors_uu, qirro_uu, lno_noise_uu, llorentz_limiter
!
!  Run parameters.
!
  real :: tdamp=0.,tfade_start=-1.,dampu=0.,wdamp=0.
  real :: dampuint=0.0,dampuext=0.0,rdampint=impossible,rdampext=impossible
  real :: ydampint=impossible,ydampext=impossible
  real :: ruxm=0.,ruym=0.,ruzm=0.
  real :: tau_damp_ruxm1=0.,tau_damp_ruym1=0.,tau_damp_ruzm1=0.
  real :: tau_damp_ruxm=0.,tau_damp_ruym=0.,tau_damp_ruzm=0.,tau_diffrot1=0.
  real :: ampl1_diffrot=0.,ampl2_diffrot=0., ampl_wind=0.
  real :: Omega_int=0.,xexp_diffrot=1.,kx_diffrot=1.,kz_diffrot=0., phase_diffrot=0.
  real :: othresh=0.,othresh_per_orms=0.,orms=0.,othresh_scl=1.
  real :: omega_out=0., omega_in=0., omega_fourier=0.
  real :: width_ff_uu=1.,x1_ff_uu=0.,x2_ff_uu=0.
  real :: ekman_friction=0.0, uzjet=0.0
  real :: ampl_forc=0., k_forc=impossible, w_forc=0., x_forc=0., dx_forc=0.1
  real :: ampl_fcont_uu=1., k_diffrot=1., amp_centforce=1.
  real :: uphi_rbot=1., uphi_rtop=1., uphi_step_width=0.
  integer :: novec,novecmax=nx*ny*nz/4, niter_relB=1
  logical :: ldamp_fade=.false.,lOmega_int=.false.,lupw_uu=.false.
  logical :: lfreeze_uint=.false.,lfreeze_uext=.false.
  logical :: lremove_mean_angmom=.false.
  logical :: lremove_mean_momenta=.false.
  logical :: lremove_mean_flow=.false.
  logical :: lremove_uumeanxy=.false.
  logical :: lremove_uumeanx=.false., lremove_uumeany=.false., lremove_uumeanz=.false.
  logical :: lremove_uumeanz_horizontal=.false.
  logical :: lreinitialize_uu=.false.
  logical :: lalways_use_gij_etc=.false.
  logical :: lcalc_uumeanz=.false.,lcalc_uumeanxy=.false.,lcalc_uumean
  logical :: lcalc_uumeanx=.false.,lcalc_uumeany=.false.,lcalc_uumeanxz=.false.
  logical :: lcalc_ruumeanz=.false.,lcalc_ruumeanxy=.false.
  logical :: lforcing_cont_uu=.false.
  logical :: lcoriolis_xdep=.false.
  logical :: lno_meridional_flow=.false.
  logical :: lrotation_xaxis=.false.
  logical :: lpropagate_borderuu=.true.
  logical :: lgradu_as_aux=.false.
  logical :: lOmega_cyl_xy=.false.
  logical :: lno_radial_advection=.false.
  logical :: lfargoadvection_as_shift=.true.
  logical :: lhelmholtz_decomp=.false.
  logical :: limpose_only_horizontal_uumz=.false.
  logical :: ltime_integrals_always=.true.
  logical :: lvart_in_shear_frame=.false.
  logical :: lSchur_3D3D1D_uu=.false.
  logical :: lSchur_2D2D3D_uu=.false.
  logical :: lSchur_2D2D1D_uu=.false.
  real :: dtcor=0.
  character (len=labellen) :: uuprof='nothing'
!
!  Parameters for interior boundary conditions.
!
  character (len=labellen) :: interior_bc_hydro_profile='nothing'
  logical :: lhydro_bc_interior=.false.
  real :: z1_interior_bc_hydro=0.,kz_analysis=1.
  real :: Shearx=0., rescale_uu=0.
  real :: Ra=0.0, Pr=0.0 ! Boussinesq approximation
  real :: Om_inner=0.
!
!  Option to constrain time for large df.
!
  real :: cdt_tauf=1.0, ulev=1.0
  logical :: lcdt_tauf=.false.
  logical, target :: lcalc_uuavg=.false.
!
  namelist /hydro_run_pars/ &
      Omega, theta, tdamp, dampu, dampuext, dampuint, rdampext, rdampint, &
      wdamp, tau_damp_ruxm, tau_damp_ruym, tau_damp_ruzm, tau_diffrot1, &
      inituu, ampluu, kz_uu, ampl1_diffrot, ampl2_diffrot, uuprof, &
      xexp_diffrot, kx_diffrot, kz_diffrot, kz_analysis, phase_diffrot, ampl_wind, &
      lreinitialize_uu, lremove_mean_momenta, lremove_mean_flow, lremove_uumeanx,&
      lremove_uumeany,lremove_uumeanxy,lremove_uumeanz,lremove_uumeanz_horizontal, &
      ldamp_fade, tfade_start, lOmega_int, Omega_int, lupw_uu, othresh, &
      othresh_per_orms, borderuu, lfreeze_uint, lpressuregradient_gas, &
      lfreeze_uext, lcoriolis_force, lcentrifugal_force, ladvection_velocity, &
      omega_out, omega_in, lprecession, omega_precession, omega_fourier, &
      alpha_precession, lshear_rateofstrain, r_omega, w_omega, &
      lconservative, lrelativistic, niter_relB, lalways_use_gij_etc, amp_centforce, &
      lcalc_uumean, lcalc_uumeanx, lcalc_uumeanxy, lcalc_uumeanxz, lcalc_uumeanz, &
      lcalc_ruumeanz, lcalc_ruumeanxy, &
      lforcing_cont_uu, width_ff_uu, x1_ff_uu, x2_ff_uu, &
      loo_as_aux, luut_as_aux, luust_as_aux, loot_as_aux, loost_as_aux, &
      llorentz_as_aux, loutest, ldiffrot_test, &
      interior_bc_hydro_profile, lhydro_bc_interior, z1_interior_bc_hydro, &
      velocity_ceiling, ekman_friction, ampl_Omega, lcoriolis_xdep, &
      ampl_forc, k_forc, w_forc, x_forc, dx_forc, ampl_fcont_uu, &
      lno_meridional_flow, lrotation_xaxis, k_diffrot,Shearx, rescale_uu, &
      hydro_xaver_range, Ra, Pr, llinearized_hydro, lremove_mean_angmom, &
      lpropagate_borderuu, hydro_zaver_range, index_rSH, &
      uzjet, ydampint, ydampext, mean_momentum, lshear_in_coriolis, &
      lcdt_tauf, cdt_tauf, ulev, &
      w_sldchar_hyd, uphi_rbot, uphi_rtop, uphi_step_width, lOmega_cyl_xy, &
      lno_radial_advection, lfargoadvection_as_shift, lhelmholtz_decomp, &
      limpose_only_horizontal_uumz, luu_fluc_as_aux, Om_inner, luu_sph_as_aux, &
      ltime_integrals_always, dtcor, lvart_in_shear_frame, lSchur_3D3D1D_uu, &
      lSchur_2D2D3D_uu, lSchur_2D2D1D_uu
!
!  Diagnostic variables (need to be consistent with reset list below).
!
  integer :: idiag_u2tm=0       ! DIAG_DOC: $\left<\uv(t)\cdot\int_0^t\uv(t')
                                ! DIAG_DOC:   dt'\right>$
  integer :: idiag_uotm=0       ! DIAG_DOC: $\left<\uv(t)\cdot\int_0^t\omv(t')
                                ! DIAG_DOC:   dt'\right>$
  integer :: idiag_outm=0       ! DIAG_DOC: $\left<\omv(t)\cdot\int_0^t\uv(t')
                                ! DIAG_DOC:   dt'\right>$
  integer :: idiag_fkinzm=0     ! DIAG_DOC: $\left<{1\over2} \varrho\uv^2 u_z\right>$
  integer :: idiag_gamm=0       ! DIAG_DOC: $\left<gamma\right>$
  integer :: idiag_gamrms=0     ! DIAG_DOC: $\left<\gamma^2\right>^{1/2}$
  integer :: idiag_gammax=0     ! DIAG_DOC: $\max(\gamma)$
  integer :: idiag_u2m=0        ! DIAG_DOC: $\left<\uv^2\right>$
  integer :: idiag_u2sphm=0     ! DIAG_DOC: $\int_{r=0}^{r=1} \uv^2 dV$,
                                ! DIAG_DOC:   where $r=\sqrt{x^2+y^2+z^2}$
  integer :: idiag_um2=0        ! DIAG_DOC:
  integer :: idiag_uxpt=0       ! DIAG_DOC: $u_x(x_1,y_1,z_1,t)$
  integer :: idiag_uypt=0       ! DIAG_DOC: $u_y(x_1,y_1,z_1,t)$
  integer :: idiag_uzpt=0       ! DIAG_DOC: $u_z(x_1,y_1,z_1,t)$
  integer :: idiag_uxp2=0       ! DIAG_DOC: $u_x(x_2,y_2,z_2,t)$
  integer :: idiag_uyp2=0       ! DIAG_DOC: $u_y(x_2,y_2,z_2,t)$
  integer :: idiag_uzp2=0       ! DIAG_DOC: $u_z(x_2,y_2,z_2,t)$
  integer :: idiag_uxuypt=0     ! DIAG_DOC: $(u_x u_y)(x_1,y_1,z_1,t)$
  integer :: idiag_uyuzpt=0     ! DIAG_DOC: $(u_y u_z)(x_1,y_1,z_1,t)$
  integer :: idiag_uzuxpt=0     ! DIAG_DOC: $(u_z u_x)(x_1,y_1,z_1,t)$
  integer :: idiag_urms=0       ! DIAG_DOC: $\left<\uv^2\right>^{1/2}$
  integer :: idiag_urmsx=0      ! DIAG_DOC: $\left<\uv^2\right>^{1/2}$ for
                                ! DIAG_DOC: the hydro_xaver_range
  integer :: idiag_urmsz=0      ! DIAG_DOC: $\left<\uv^2\right>^{1/2}$ for
                                ! DIAG_DOC: the hydro_zaver_range
  integer :: idiag_durms=0      ! DIAG_DOC: $\left<\delta\uv^2\right>^{1/2}$
  integer :: idiag_umax=0       ! DIAG_DOC: $\max(|\uv|)$
  integer :: idiag_umin=0       ! DIAG_DOC: $\min(|\uv|)$
  integer :: idiag_uxrms=0      ! DIAG_DOC: $\left<u_x^2\right>^{1/2}$
  integer :: idiag_uyrms=0      ! DIAG_DOC: $\left<u_y^2\right>^{1/2}$
  integer :: idiag_uzrms=0      ! DIAG_DOC: $\left<u_z^2\right>^{1/2}$
  integer :: idiag_uzrmaxs=0    ! DIAG_DOC:
  integer :: idiag_uxmin=0      ! DIAG_DOC: $\min(|u_x|)$
  integer :: idiag_uymin=0      ! DIAG_DOC: $\min(|u_y|)$
  integer :: idiag_uzmin=0      ! DIAG_DOC: $\min(|u_z|)$
  integer :: idiag_uxmax=0      ! DIAG_DOC: $\max(|u_x|)$
  integer :: idiag_uymax=0      ! DIAG_DOC: $\max(|u_y|)$
  integer :: idiag_uzmax=0      ! DIAG_DOC: $\max(|u_z|)$
  integer :: idiag_uxm=0        ! DIAG_DOC: $\left<u_x\right>$
  integer :: idiag_uym=0        ! DIAG_DOC: $\left<u_y\right>$
  integer :: idiag_uzm=0        ! DIAG_DOC: $\left<u_z\right>$
  integer :: idiag_uzcx10m=0    ! DIAG_DOC: $\left<u_z\cos10x\right>$
  integer :: idiag_uzsx10m=0    ! DIAG_DOC: $\left<u_z\sin10x\right>$
  integer :: idiag_uduum=0      ! DIAG_DOC: $\left<\boldsymbol{u}\cdot\boldsymbol{u}\right>$
  integer :: idiag_ux2m=0       ! DIAG_DOC: $\left<u_x^2\right>$
  integer :: idiag_uy2m=0       ! DIAG_DOC: $\left<u_y^2\right>$
  integer :: idiag_uz2m=0       ! DIAG_DOC: $\left<u_z^2\right>$
  integer :: idiag_ux3m=0       ! DIAG_DOC: $\left<u_x^3\right>$
  integer :: idiag_uy3m=0       ! DIAG_DOC: $\left<u_y^3\right>$
  integer :: idiag_uz3m=0       ! DIAG_DOC: $\left<u_z^3\right>$
  integer :: idiag_ux4m=0       ! DIAG_DOC: $\left<u_x^4\right>$
  integer :: idiag_uy4m=0       ! DIAG_DOC: $\left<u_y^4\right>$
  integer :: idiag_uz4m=0       ! DIAG_DOC: $\left<u_z^4\right>$
  integer :: idiag_uxuy2m=0     ! DIAG_DOC: $\left<u_x^2u_y^2\right>$
  integer :: idiag_uyuz2m=0     ! DIAG_DOC: $\left<u_y^2u_z^2\right>$
  integer :: idiag_uzux2m=0     ! DIAG_DOC: $\left<u_z^2u_x^2\right>$
  integer :: idiag_ux2ccm=0     ! DIAG_DOC: $\left<u_x^2\cos^2kz\right>$
  integer :: idiag_ux2ssm=0     ! DIAG_DOC: $\left<u_x^2\sin^2kz\right>$
  integer :: idiag_uy2ccm=0     ! DIAG_DOC: $\left<u_y^2\cos^2kz\right>$
  integer :: idiag_uy2ssm=0     ! DIAG_DOC: $\left<u_y^2\sin^2kz\right>$
  integer :: idiag_uxuycsm=0    ! DIAG_DOC: $\left<u_xu_y\cos kz\sin kz\right>$
  integer :: idiag_uxuym=0      ! DIAG_DOC: $\left<u_x u_y\right>$
  integer :: idiag_uxuzm=0      ! DIAG_DOC: $\left<u_x u_z\right>$
  integer :: idiag_uyuzm=0      ! DIAG_DOC: $\left<u_y u_z\right>$
  integer :: idiag_umx=0        ! DIAG_DOC: $\left< u_x \right>$
  integer :: idiag_umy=0        ! DIAG_DOC: $\left< u_y \right>$
  integer :: idiag_umz=0        ! DIAG_DOC: $\left< u_z \right>$
  integer :: idiag_omumz=0      ! DIAG_DOC: $\left<\left<\Wv\right>_{xy}
                                ! DIAG_DOC:   \cdot\left<\Uv\right>_{xy}
                                ! DIAG_DOC:   \right>$ \quad($xy$-averaged
                                ! DIAG_DOC:   mean cross helicity production)
  integer :: idiag_umamz=0      ! DIAG_DOC: $\left<\left<\uv\right>_{xy}\cdot\left<\Av\right>_{xy}\right>$
  integer :: idiag_umbmz=0      ! DIAG_DOC: $\left<\left<\Uv\right>_{xy}
                                ! DIAG_DOC:   \cdot\left<\Bv\right>_{xy}
                                ! DIAG_DOC:   \right>$ \quad($xy$-averaged
                                ! DIAG_DOC:   mean cross helicity production)
  integer :: idiag_umxbmz=0     ! DIAG_DOC: $\left<\left<\Uv\right>_{xy}
                                ! DIAG_DOC:   \times\left<\Bv\right>_{xy}
                                ! DIAG_DOC:   \right>_z$ \quad($xy$-averaged
                                ! DIAG_DOC:   mean emf)
  integer :: idiag_rux2m=0      ! DIAG_DOC: $\left<\rho u_x^2\right>$
  integer :: idiag_ruy2m=0      ! DIAG_DOC: $\left<\rho u_y^2\right>$
  integer :: idiag_ruz2m=0      ! DIAG_DOC: $\left<\rho u_z^2\right>$
  integer :: idiag_divum=0      ! DIAG_DOC: $\left<{\rm div}\uv)\right>$
  integer :: idiag_rdivum=0     ! DIAG_DOC: $\left<\varrho{\rm div}\uv)\right>$
  integer :: idiag_divu2m=0     ! DIAG_DOC: $\left<({\rm div}\uv)^2\right>$
  integer :: idiag_gdivu2m=0    ! DIAG_DOC: $\left<({\rm grad\,div}\uv)^2\right>$
  integer :: idiag_u3u21m=0     ! DIAG_DOC: $\left<u_3 u_{2,1}\right>$
  integer :: idiag_u1u32m=0     ! DIAG_DOC: $\left<u_1 u_{3,2}\right>$
  integer :: idiag_u2u13m=0     ! DIAG_DOC: $\left<u_2 u_{1,3}\right>$
  integer :: idiag_u2u31m=0     ! DIAG_DOC: $\left<u_2 u_{3,1}\right>$
  integer :: idiag_u3u12m=0     ! DIAG_DOC: $\left<u_3 u_{1,2}\right>$
  integer :: idiag_u1u23m=0     ! DIAG_DOC: $\left<u_1 u_{2,3}\right>$
  integer :: idiag_urmphi=0     ! PHIAVG_DOC: $\left<u_\varpi\right>_\varphi$
                                ! PHIAVG_DOC: [cyl.\ polar coords
                                ! PHIAVG_DOC:  $(\varpi,\varphi,z)$]
  integer :: idiag_upmphi=0     ! PHIAVG_DOC: $\left<u_\varphi\right>_\varphi$
  integer :: idiag_uzmphi=0     ! PHIAVG_DOC: $\left<u_z\right>_\varphi$
  integer :: idiag_rurmphi=0    ! PHIAVG_DOC: $\left<\rho u_\varpi\right>_\varphi$
  integer :: idiag_rupmphi=0    ! PHIAVG_DOC: $\left<\rho u_\varphi\right>_\varphi$
  integer :: idiag_ruzmphi=0    ! PHIAVG_DOC: $\left<\rho u_z\right>_\varphi$
  integer :: idiag_ur2mphi=0    ! PHIAVG_DOC: $\left<u_\varpi^2\right>_\varphi$
  integer :: idiag_up2mphi=0    ! PHIAVG_DOC: $\left<u_\varphi^2\right>_\varphi$
  integer :: idiag_uz2mphi=0    ! PHIAVG_DOC: $\left<u_z^2\right>_\varphi$
  integer :: idiag_urupmphi=0   ! PHIAVG_DOC: $\left<u_\varpi u_\varphi\right>_\varphi$
  integer :: idiag_uruzmphi=0   ! PHIAVG_DOC: $\left<u_\varpi u_z \right>_\varphi$
  integer :: idiag_upuzmphi=0   ! PHIAVG_DOC: $\left<u_\varphi u_z \right>_\varphi$
  integer :: idiag_rurupmphi=0  ! PHIAVG_DOC: $\left<\rho u_\varpi u_\varphi\right>_\varphi$
  integer :: idiag_ruruzmphi=0  ! PHIAVG_DOC: $\left<\rho u_\varpi u_z \right>_\varphi$
  integer :: idiag_rupuzmphi=0  ! PHIAVG_DOC: $\left<\rho u_\varphi u_z \right>_\varphi$
  integer :: idiag_ursphmphi=0  ! PHIAVG_DOC: $\left<u_r\right>_\varphi$
  integer :: idiag_uthmphi=0    ! PHIAVG_DOC: $\left<u_\vartheta\right>_\varphi$
  integer :: idiag_rursphmphi=0 ! PHIAVG_DOC: $\left<\rho u_r\right>_\varphi$
  integer :: idiag_ruthmphi=0   ! PHIAVG_DOC: $\left<\rho u_\vartheta\right>_\varphi$
  ! For the manual: uumphi      ! PHIAVG_DOC: shorthand for \var{urmphi},
                                ! PHIAVG_DOC: \var{upmphi} and \var{uzmphi}
                                ! PHIAVG_DOC: together
  ! For the manual: uusphmphi   ! PHIAVG_DOC: shorthand for \var{ursphmphi},
                                ! PHIAVG_DOC: \var{uthmphi} and \var{upmphi}
                                ! PHIAVG_DOC: together
  integer :: idiag_u2mphi=0     ! PHIAVG_DOC: $\left<\uv^2\right>_\varphi$
  integer :: idiag_fkinrsphmphi=0 ! PHIAVG_DOC: $\left<{1\over2}\varrho\uv^2
                                ! PHIAVG_DOC: u_r\right>_{\varphi}$
  integer :: idiag_u2mr=0       ! DIAG_DOC:
  integer :: idiag_urmr=0       ! DIAG_DOC:
  integer :: idiag_upmr=0       ! DIAG_DOC:
  integer :: idiag_uzmr=0       ! DIAG_DOC:
  integer :: idiag_uxfampm=0    ! DIAG_DOC:
  integer :: idiag_uyfampm=0    ! DIAG_DOC:
  integer :: idiag_uzfampm=0    ! DIAG_DOC:
  integer :: idiag_uxfampim=0   ! DIAG_DOC:
  integer :: idiag_uyfampim=0   ! DIAG_DOC:
  integer :: idiag_uzfampim=0   ! DIAG_DOC:
  integer :: idiag_ruxm=0       ! DIAG_DOC: $\left<\varrho u_x\right>$
                                ! DIAG_DOC:   \quad(mean $x$-momentum density)
  integer :: idiag_ruym=0       ! DIAG_DOC: $\left<\varrho u_y\right>$
                                ! DIAG_DOC:   \quad(mean $y$-momentum density)
  integer :: idiag_ruzm=0       ! DIAG_DOC: $\left<\varrho u_z\right>$
                                ! DIAG_DOC:   \quad(mean $z$-momentum density)
  integer :: idiag_ruxtot=0     ! DIAG_DOC: $\left<\rho |u|\right>$
                                ! DIAG_DOC:   \quad(mean absolute $x$-momentum density)
  integer :: idiag_rumax=0      ! DIAG_DOC: $\max(\varrho |\uv|)$
                                ! DIAG_DOC:   \quad(maximum modulus of momentum)
  integer :: idiag_ruxuym=0     ! DIAG_DOC: $\left<\varrho u_x u_y\right>$
                                ! DIAG_DOC:   \quad(mean Reynolds stress)
  integer :: idiag_ruxuzm=0     ! DIAG_DOC: $\left<\varrho u_x u_z\right>$
                                ! DIAG_DOC:   \quad(mean Reynolds stress)
  integer :: idiag_ruyuzm=0     ! DIAG_DOC: $\left<\varrho u_y u_z\right>$
                                ! DIAG_DOC:   \quad(mean Reynolds stress)
  integer :: idiag_divrhourms=0 ! DIAG_DOC: $\left|\nabla\cdot(\varrho\uv)\right|_{\rm rms}$
  integer :: idiag_divrhoumax=0 ! DIAG_DOC: $\left|\nabla\cdot(\varrho\uv)\right|_{\rm max}$
  integer :: idiag_rlxm=0       ! DIAG_DOC: $\left< \rho y u_z - z u_y \right>$
  integer :: idiag_rlym=0       ! DIAG_DOC: $\left< \rho z u_x - x u_z \right>$
  integer :: idiag_rlzm=0       ! DIAG_DOC: $\left< \rho x u_y - y u_x \right>$
  integer :: idiag_rlx2m=0      ! DIAG_DOC: $\left<(\rho y u_z-z u_y)^2\right>$
  integer :: idiag_rly2m=0      ! DIAG_DOC: $\left<(\rho z u_x-x u_z)^2\right>$
  integer :: idiag_rlz2m=0      ! DIAG_DOC: $\left<(\rho x u_y-y u_x)^2\right>$
  integer :: idiag_tot_ang_mom=0! DIAG_DOC: Total angular momentum in spherical
                                ! DIAG_DOC: coordinates about the axis.
  integer :: idiag_dtu=0        ! DIAG_DOC: $\delta t/[c_{\delta t}\,\delta x
                                ! DIAG_DOC:  /\max|\mathbf{u}|]$
                                ! DIAG_DOC:  \quad(time step relative to
                                ! DIAG_DOC:   advective time step;
                                ! DIAG_DOC:   see \S~\ref{time-step})
  integer :: idiag_oum=0        ! DIAG_DOC: $\left<\boldsymbol{\omega}\cdot\uv\right>$
  integer :: idiag_oxum=0       ! DIAG_DOC: $\left<\boldsymbol{\omega}\times\uv\right>$
  integer :: idiag_ourms=0      ! DIAG_DOC: $\left<(\boldsymbol{\omega}\cdot\uv)^2\right>^{1/2}$
  integer :: idiag_oxurms=0     ! DIAG_DOC: $\left<(\boldsymbol{\omega}\times\uv)^2\right>^{1/2}$
  integer :: idiag_ou_int=0     ! DIAG_DOC: $\int_V\boldsymbol{\omega}\cdot\uv\,dV$
  integer :: idiag_fum=0        ! DIAG_DOC: $\left<\fv\cdot\uv\right>$
  integer :: idiag_odel2um=0    ! DIAG_DOC: $\left<\boldsymbol{\omega}\nabla^2\uv\right>$
  integer :: idiag_o2m=0        ! DIAG_DOC: $\left<\boldsymbol{\omega}^2\right>
                                ! DIAG_DOC:   \equiv \left<(\curl\uv)^2\right>$
  integer :: idiag_o2u2m=0      ! DIAG_DOC: $\left<\uv^2\boldsymbol{\omega}^2\right>$
  integer :: idiag_o2sphm=0     ! DIAG_DOC: $\int_{r=0}^{r=1} \boldsymbol{\omega}^2 dV$,
                                ! DIAG_DOC:   where $r=\sqrt{x^2+y^2+z^2}$
  integer :: idiag_orms=0       ! DIAG_DOC: $\left<\boldsymbol{\omega}^2\right>^{1/2}$
  integer :: idiag_omax=0       ! DIAG_DOC: $\max(|\boldsymbol{\omega}|)$
  integer :: idiag_ox2m=0       ! DIAG_DOC: $\left<\omega_x^2\right>$
  integer :: idiag_oy2m=0       ! DIAG_DOC: $\left<\omega_y^2\right>$
  integer :: idiag_oz2m=0       ! DIAG_DOC: $\left<\omega_z^2\right>$
  integer :: idiag_ox3m=0       ! DIAG_DOC: $\left<\omega_x^3\right>$
  integer :: idiag_oy3m=0       ! DIAG_DOC: $\left<\omega_y^3\right>$
  integer :: idiag_oz3m=0       ! DIAG_DOC: $\left<\omega_z^3\right>$
  integer :: idiag_ox4m=0       ! DIAG_DOC: $\left<\omega_x^4\right>$
  integer :: idiag_oy4m=0       ! DIAG_DOC: $\left<\omega_y^4\right>$
  integer :: idiag_oz4m=0       ! DIAG_DOC: $\left<\omega_z^4\right>$
  integer :: idiag_oxm=0        ! DIAG_DOC:
  integer :: idiag_oym=0        ! DIAG_DOC:
  integer :: idiag_ozm=0        ! DIAG_DOC:
  integer :: idiag_oxuzxm=0     ! DIAG_DOC: $\left<\omega_x u_{z,x} \right>$
  integer :: idiag_oyuzym=0     ! DIAG_DOC: $\left<\omega_y u_{z,y} \right>$
  integer :: idiag_oxoym=0      ! DIAG_DOC: $\left<\omega_x\omega_y\right>$
  integer :: idiag_oxozm=0      ! DIAG_DOC: $\left<\omega_x\omega_z\right>$
  integer :: idiag_oyozm=0      ! DIAG_DOC: $\left<\omega_y\omega_z\right>$
  integer :: idiag_qfm=0        ! DIAG_DOC: $\left<\qv\cdot\fv\right>$
  integer :: idiag_q2m=0        ! DIAG_DOC: $\left<\qv^2\right>$
  integer :: idiag_qrms=0       ! DIAG_DOC: $\left<\qv^2\right>^{1/2}$
  integer :: idiag_qmax=0       ! DIAG_DOC: $\max(|\qv|)$
  integer :: idiag_qom=0        ! DIAG_DOC: $\left<\qv\cdot\omv\right>$
  integer :: idiag_quxom=0      ! DIAG_DOC: $\left<\qv\cdot(\uv\times\omv)\right>$
  integer :: idiag_pvzm=0       ! DIAG_DOC: $\left<\omega_z + 2\Omega/\varrho\right>$
                                ! DIAG_DOC: \quad(z component of potential vorticity)
  integer :: idiag_oumphi=0     ! DIAG_DOC: $\left<\omv\cdot\uv\right>_\varphi$
  integer :: idiag_ozmphi=0     ! DIAG_DOC:
  integer :: idiag_ormr=0       ! DIAG_DOC:
  integer :: idiag_opmr=0       ! DIAG_DOC:
  integer :: idiag_ozmr=0       ! DIAG_DOC:
  integer :: idiag_uguxm=0      ! DIAG_DOC:
  integer :: idiag_uguym=0      ! DIAG_DOC:
  integer :: idiag_uguzm=0      ! DIAG_DOC:
  integer :: idiag_ugurmsx=0    ! DIAG_DOC: $\left<\left(\uv\nabla\uv\right)^2\right>^{1/2}$
                                ! DIAG_DOC: for the hydro_xaver_range
  integer :: idiag_ugu2m=0      ! DIAG_DOC: $\left<\uv\nabla\uv\right>^2$
  integer :: idiag_dudx=0        ! DIAG_DOC: $\left<\frac{\delta \uv}{\delta x}\right>$
  integer :: idiag_Marms=0      ! DIAG_DOC: $\left<\uv^2/\cs^2\right>$
                                ! DIAG_DOC:   \quad(rms Mach number)
  integer :: idiag_Mamax=0      ! DIAG_DOC: $\max |\uv|/\cs$
                                ! DIAG_DOC:   \quad(maximum Mach number)
  integer :: idiag_fintm=0      ! DIAG_DOC:
  integer :: idiag_fextm=0      ! DIAG_DOC:
  integer :: idiag_duxdzma=0    ! DIAG_DOC:
  integer :: idiag_duydzma=0    ! DIAG_DOC:
  integer :: idiag_EEK=0        ! DIAG_DOC: $\left<\varrho\uv^2\right>/2$
  integer :: idiag_ekin=0       ! DIAG_DOC: $\left<{1\over2}\varrho\uv^2\right>$
  integer :: idiag_ekintot=0    ! DIAG_DOC: $\int_V{1\over2}\varrho\uv^2\, dV$
  integer :: idiag_totangmom=0  ! DIAG_DOC:
  integer :: idiag_uxglnrym=0   ! DIAG_DOC: $\left<u_x\partial_y\ln\varrho\right>$
  integer :: idiag_uyglnrxm=0   ! DIAG_DOC: $\left<u_y\partial_x\ln\varrho\right>$
  integer :: idiag_uzdivum=0    ! DIAG_DOC: $\left<u_z\nabla\cdot\uv\right>$
  integer :: idiag_uxuydivum=0  ! DIAG_DOC: $\left<u_x u_y\nabla\cdot\uv\right>$
  integer :: idiag_divuHrms=0   ! DIAG_DOC: $(\nabla_{\rm H}\cdot\uv_{\rm H})^{\rm rms}$
  integer :: idiag_uxxrms=0     ! DIAG_DOC: $u_{x,x}^{\rm rms}$
  integer :: idiag_uyyrms=0     ! DIAG_DOC: $u_{y,y}^{\rm rms}$
  integer :: idiag_uxzrms=0     ! DIAG_DOC: $u_{x,z}^{\rm rms}$
  integer :: idiag_uyzrms=0     ! DIAG_DOC: $u_{y,z}^{\rm rms}$
  integer :: idiag_uzyrms=0     ! DIAG_DOC: $u_{z,y}^{\rm rms}$
  integer :: idiag_urmsn=0,idiag_urmss=0,idiag_urmsh=0
  integer :: idiag_ormsn=0,idiag_ormss=0,idiag_ormsh=0
  integer :: idiag_oumn=0,idiag_oums=0,idiag_oumh=0
  integer :: idiag_taufmin=0
  integer :: idiag_dtF=0        ! DIAG_DOC: $\delta t/[c_{\delta t}\,\delta x
                                ! DIAG_DOC:  /\max|\mathbf{F}|]$
                                ! DIAG_DOC:  \quad(time step relative to
                                ! DIAG_DOC:   max force time step;
                                ! DIAG_DOC:   see \S~\ref{time-step})
!
  integer, dimension(Nmodes_SH) :: idiag_urlm=0 ! DIAG_DOC: $ \int u_r(\theta,\phi)Y^m_{\ell}(\theta,\phi)\sin(\theta)d\theta d\phi$
  integer :: idiag_udpxxm=0, &  ! DIAG_DOC: components of symmetric tensor
             idiag_udpyym=0, &  ! DIAG_DOC: $\left< u_i \partial_j p + u_j \partial_i p \right>$
             idiag_udpzzm=0, &
             idiag_udpxym=0, &
             idiag_udpyzm=0, &
             idiag_udpxzm=0
!
! xy averaged diagnostics given in xyaver.in
!
  integer :: idiag_u2mz=0       ! XYAVG_DOC: $\left< \uv^2 \right>_{xy}$
  integer :: idiag_o2mz=0       ! XYAVG_DOC: $\left< \Wv^2 \right>_{xy}$
  integer :: idiag_divu2mz=0    ! XYAVG_DOC: $\left<(\nabla\cdot\uv)^2\right>_{xy}$
  integer :: idiag_curlru2mz=0  ! XYAVG_DOC: $\left<(\nabla\times\varrho\Uv)^2 \right>_{xy}$
  integer :: idiag_divru2mz=0   ! XYAVG_DOC: $\left<(\nabla\cdot\varrho\uv)^2\right>_{xy}$
  integer :: idiag_fmasszmz=0   ! XYAVG_DOC: $\left< \varrho u_z \right>_{xy}$
  integer :: idiag_fkinzmz=0    ! XYAVG_DOC: $\left<{1\over2}\varrho\uv^2 u_z\right>_{xy}$
  integer :: idiag_fkinzupmz=0  ! XYAVG_DOC: $\left<{1\over2}\varrho\uv^2 u_{z\uparrow}\right>_{xy}$
  integer :: idiag_fkinzdownmz=0 ! XYAVG_DOC: $\left<{1\over2}\varrho\uv^2 u_{z\downarrow}\right>_{xy}$
  integer :: idiag_uxmz=0       ! XYAVG_DOC: $\left< u_x \right>_{xy}$
                                ! XYAVG_DOC:   \quad(horiz. averaged $x$
                                ! XYAVG_DOC:   velocity)
  integer :: idiag_uymz=0       ! XYAVG_DOC: $\left< u_y \right>_{xy}$
  integer :: idiag_uzmz=0       ! XYAVG_DOC: $\left< u_z \right>_{xy}$
  integer :: idiag_ffdownmz=0   ! XYAVG_DOC: Filling factor of downflows
  integer :: idiag_uzupmz=0     ! XYAVG_DOC: $\left< u_{z\uparrow} \right>_{xy}$
  integer :: idiag_uzdownmz=0   ! XYAVG_DOC: $\left< u_{z\downarrow} \right>_{xy}$
  integer :: idiag_ruzupmz=0    ! XYAVG_DOC: $\left< \varrho u_{z\uparrow} \right>_{xy}$
  integer :: idiag_ruzdownmz=0  ! XYAVG_DOC: $\left< \varrho u_{z\downarrow} \right>_{xy}$
  integer :: idiag_divumz=0     ! XYAVG_DOC: $\left< {\rm div}\uv \right>_{xy}$
  integer :: idiag_uzdivumz=0   ! XYAVG_DOC: $\left< u_z{\rm div}\uv \right>_{xy}$
  integer :: idiag_oxmz=0       ! XYAVG_DOC: $\left< \omega_x \right>_{xy}$
  integer :: idiag_oymz=0       ! XYAVG_DOC: $\left< \omega_y \right>_{xy}$
  integer :: idiag_ozmz=0       ! XYAVG_DOC: $\left< \omega_z \right>_{xy}$
  integer :: idiag_ux2mz=0      ! XYAVG_DOC: $\left<u_x^2\right>_{xy}$
  integer :: idiag_uy2mz=0      ! XYAVG_DOC: $\left<u_y^2\right>_{xy}$
  integer :: idiag_uz2mz=0      ! XYAVG_DOC: $\left<u_z^2\right>_{xy}$
  integer :: idiag_uz2upmz=0    ! XYAVG_DOC: $\left<u_{z\uparrow}^2\right>_{xy}$
  integer :: idiag_uz2downmz=0  ! XYAVG_DOC: $\left<u_{z\downarrow}^2\right>_{xy}$
  integer :: idiag_ox2mz=0      ! XYAVG_DOC: $\left< \omega_x^2 \right>_{xy}$
  integer :: idiag_oy2mz=0      ! XYAVG_DOC: $\left< \omega_y^2 \right>_{xy}$
  integer :: idiag_oz2mz=0      ! XYAVG_DOC: $\left< \omega_z^2 \right>_{xy}$
  integer :: idiag_ruxmz=0      ! XYAVG_DOC: $\left<\varrho u_x \right>_{xy}$
  integer :: idiag_ruymz=0      ! XYAVG_DOC: $\left<\varrho u_y \right>_{xy}$
  integer :: idiag_ruzmz=0      ! XYAVG_DOC: $\left<\varrho u_z \right>_{xy}$
  integer :: idiag_rux2mz=0     ! XYAVG_DOC: $\left<\varrho u_x^2\right>_{xy}$
  integer :: idiag_ruy2mz=0     ! XYAVG_DOC: $\left<\varrho u_y^2\right>_{xy}$
  integer :: idiag_ruz2mz=0     ! XYAVG_DOC: $\left<\varrho u_z^2\right>_{xy}$
  integer :: idiag_uxuymz=0     ! XYAVG_DOC: $\left<u_x u_y\right>_{xy}$
  integer :: idiag_uxuzmz=0     ! XYAVG_DOC: $\left<u_x u_z\right>_{xy}$
  integer :: idiag_uyuzmz=0     ! XYAVG_DOC: $\left<u_y u_z\right>_{xy}$
  integer :: idiag_Rxymz=0      ! XYAVG_DOC: $\left<u_x' u_y'\right>_{xy}$
  integer :: idiag_Rxyupmz=0    ! XYAVG_DOC: $\left<u_{x\downarrow}' u_{y\downarrow}'\right>_{xy}$
  integer :: idiag_Rxydownmz=0  ! XYAVG_DOC: $\left<u_{x\uparrow}' u_{y\uparrow}'\right>_{xy}$
  integer :: idiag_Rxzmz=0      ! XYAVG_DOC: $\left<u_x' u_z'\right>_{xy}$
  integer :: idiag_Rxzupmz=0    ! XYAVG_DOC: $\left<u_{x\downarrow}' u_{z\downarrow}'\right>_{xy}$
  integer :: idiag_Rxzdownmz=0  ! XYAVG_DOC: $\left<u_{x\uparrow}' u_{z\uparrow}'\right>_{xy}$
  integer :: idiag_Ryzmz=0      ! XYAVG_DOC: $\left<u_y' u_z'\right>_{xy}$
  integer :: idiag_Ryzupmz=0    ! XYAVG_DOC: $\left<u_{y\downarrow}' u_{z\downarrow}'\right>_{xy}$
  integer :: idiag_Ryzdownmz=0  ! XYAVG_DOC: $\left<u_{y\uparrow}' u_{z\uparrow}'\right>_{xy}$
  integer :: idiag_ruxuymz=0    ! XYAVG_DOC: $\langle\rho u_x u_y\rangle_{xy}$
  integer :: idiag_ruxuzmz=0    ! XYAVG_DOC: $\langle\rho u_x u_z\rangle_{xy}$
  integer :: idiag_ruyuzmz=0    ! XYAVG_DOC: $\langle\rho u_y u_z\rangle_{xy}$
  integer :: idiag_ruxuy2mz=0   ! XYAVG_DOC: $\langle\rho u_x u_y\rangle_{xy}$
  integer :: idiag_ruxuz2mz=0   ! XYAVG_DOC: $\langle\rho u_x u_z\rangle_{xy}$
  integer :: idiag_ruyuz2mz=0   ! XYAVG_DOC: $\langle\rho u_y u_z\rangle_{xy}$
  integer :: idiag_oxuxxmz=0    ! XYAVG_DOC: $\left<\omega_x u_{x,x}\right>_{xy}$
  integer :: idiag_oyuxymz=0    ! XYAVG_DOC: $\left<\omega_y u_{x,y}\right>_{xy}$
  integer :: idiag_oxuyxmz=0    ! XYAVG_DOC: $\left<\omega_x u_{y,x}\right>_{xy}$
  integer :: idiag_oyuyymz=0    ! XYAVG_DOC: $\left<\omega_y u_{y,y}\right>_{xy}$
  integer :: idiag_oxuzxmz=0    ! XYAVG_DOC: $\left<\omega_x u_{z,x}\right>_{xy}$
  integer :: idiag_oyuzymz=0    ! XYAVG_DOC: $\left<\omega_y u_{z,y}\right>_{xy}$
  integer :: idiag_uyxuzxmz=0   ! XYAVG_DOC: $\left<u_{y,x} u_{z,x}\right>_{xy}$
  integer :: idiag_uyyuzymz=0   ! XYAVG_DOC: $\left<u_{y,y} u_{z,y}\right>_{xy}$
  integer :: idiag_uyzuzzmz=0   ! XYAVG_DOC: $\left<u_{y,z} u_{z,z}\right>_{xy}$
  integer :: idiag_ekinmz=0     ! XYAVG_DOC: $\left<{1\over2}\varrho\uv^2\right>_{xy}$
  integer :: idiag_oumz=0       ! XYAVG_DOC: $\left<\boldsymbol{\omega}
                                ! XYAVG_DOC: \cdot\uv\right>_{xy}$
  integer :: idiag_uguxmz=0     ! XYAVG_DOC:
  integer :: idiag_uguymz=0     ! XYAVG_DOC:
  integer :: idiag_uguzmz=0     ! XYAVG_DOC:
  integer :: idiag_Remz=0       ! XYAVG_DOC: $\langle\frac{|\uv\cdot\uv|}{\left|
                                ! XYAVG_DOC: \frac{\partial}{\partial x_j}
                                ! XYAVG_DOC: (\nu{\sf S}_{ij})\right|}\rangle_{xy}$
  integer :: idiag_oguxmz=0     ! XYAVG_DOC: $\left<(\boldsymbol{\omega}
                                ! XYAVG_DOC: \cdot\nabla \uv)_x\right>_{xy}$
  integer :: idiag_oguymz=0     ! XYAVG_DOC: $\left<(\boldsymbol{\omega}
                                ! XYAVG_DOC: \cdot\nabla \uv)_y\right>_{xy}$
  integer :: idiag_oguzmz=0     ! XYAVG_DOC: $\left<(\boldsymbol{\omega}
                                ! XYAVG_DOC: \cdot\nabla \uv)_z\right>_{xy}$
  integer :: idiag_ogux2mz=0    ! XYAVG_DOC: $\left<(\boldsymbol{\omega}
                                ! XYAVG_DOC: \cdot\nabla \uv)_x^2\right>_{xy}$
  integer :: idiag_oguy2mz=0    ! XYAVG_DOC: $\left<(\boldsymbol{\omega}
                                ! XYAVG_DOC: \cdot\nabla \uv)_y^2\right>_{xy}$
  integer :: idiag_oguz2mz=0    ! XYAVG_DOC: $\left<(\boldsymbol{\omega}
                                ! XYAVG_DOC:\cdot\nabla \uv)_z^2\right>_{xy}$
  integer :: idiag_oxdivumz=0   ! XYAVG_DOC: $\left<\omega_x\nabla\cdot\uv\right>_{xy}$
  integer :: idiag_oydivumz=0   ! XYAVG_DOC: $\left<\omega_y\nabla\cdot\uv\right>_{xy}$
  integer :: idiag_ozdivumz=0   ! XYAVG_DOC: $\left<\omega_z\nabla\cdot\uv\right>_{xy}$
  integer :: idiag_oxdivu2mz=0  ! XYAVG_DOC: $\left<(\omega_x\nabla\cdot\uv)^2\right>_{xy}$
  integer :: idiag_oydivu2mz=0  ! XYAVG_DOC: $\left<(\omega_y\nabla\cdot\uv)^2\right>_{xy}$
  integer :: idiag_ozdivu2mz=0  ! XYAVG_DOC: $\left<(\omega_z\nabla\cdot\uv)^2\right>_{xy}$
  integer :: idiag_u3u21mz=0    ! XYAVG_DOC:
  integer :: idiag_u1u32mz=0    ! XYAVG_DOC:
  integer :: idiag_u2u13mz=0    ! XYAVG_DOC:
  integer :: idiag_u2u31mz=0    ! XYAVG_DOC:
  integer :: idiag_u3u12mz=0    ! XYAVG_DOC:
  integer :: idiag_u1u23mz=0    ! XYAVG_DOC:
  integer :: idiag_acczmz=0     ! XYAVG_DOC: $\left<Du_z/Dt\right>_{xy}$
  integer :: idiag_acczupmz=0   ! XYAVG_DOC: $\left<Du_z/Dt\right>_{xy+}$
  integer :: idiag_acczdownmz=0 ! XYAVG_DOC: $\left<Du_z/Dt\right>_{xy-}$
  integer :: idiag_accpowzmz=0  ! XYAVG_DOC: $\left<(u_z Du_z/Dt)^2\right>_{xy}$
  integer :: idiag_accpowzupmz=0  ! XYAVG_DOC: $\left<(u_z Du_z/Dt)^2\right>_{xy+}$
  integer :: idiag_accpowzdownmz=0! XYAVG_DOC: $\left<(u_z Du_z/Dt)^2\right>_{xy-}$
  integer :: idiag_totalforcezmz=0     ! XYAVG_DOC: $\left<\varrho Du_z/Dt\right>_{xy}$
  integer :: idiag_totalforcezupmz=0   ! XYAVG_DOC: $\left<\varrho Du_z/Dt\right>_{xy+}$
  integer :: idiag_totalforcezdownmz=0 ! XYAVG_DOC: $\left<\varrho Du_z/Dt\right>_{xy-}$
!
! xz averaged diagnostics given in xzaver.in
!
  integer :: idiag_uxmy=0       ! XZAVG_DOC: $\left< u_x \right>_{xz}$
  integer :: idiag_uymy=0       ! XZAVG_DOC: $\left< u_y \right>_{xz}$
  integer :: idiag_uzmy=0       ! XZAVG_DOC: $\left< u_z \right>_{xz}$
  integer :: idiag_ux2my=0      ! XZAVG_DOC:
  integer :: idiag_uy2my=0      ! XZAVG_DOC:
  integer :: idiag_uz2my=0      ! XZAVG_DOC:
  integer :: idiag_uxuymy=0     ! XZAVG_DOC:
  integer :: idiag_uxuzmy=0     ! XZAVG_DOC:
  integer :: idiag_uyuzmy=0     ! XZAVG_DOC:
  integer :: idiag_oumy=0       ! XZAVG_DOC: $\left<\boldsymbol{\omega}
                                ! XZAVG_DOC: \cdot\uv\right>_{xz}$
  integer :: idiag_uguxmy=0     ! XZAVG_DOC:
  integer :: idiag_uguymy=0     ! XZAVG_DOC:
  integer :: idiag_uguzmy=0     ! XZAVG_DOC:
!
! yz averaged diagnostics given in yzaver.in
!
  integer :: idiag_uxmx=0       ! YZAVG_DOC: $\left< u_x \right>_{yz}$
  integer :: idiag_uymx=0       ! YZAVG_DOC: $\left< u_y \right>_{yz}$
  integer :: idiag_uzmx=0       ! YZAVG_DOC: $\left< u_z \right>_{yz}$
  integer :: idiag_ruxmx=0      ! YZAVG_DOC: $\left<\varrho u_x \right>_{yz}$
  integer :: idiag_ruymx=0      ! YZAVG_DOC: $\left<\varrho u_y \right>_{yz}$
  integer :: idiag_ruzmx=0      ! YZAVG_DOC: $\left<\varrho u_z \right>_{yz}$
  integer :: idiag_rux2mx = 0   ! YZAVG_DOC: $\langle\rho u_x^2\rangle_{yz}$
  integer :: idiag_ruy2mx = 0   ! YZAVG_DOC: $\langle\rho u_y^2\rangle_{yz}$
  integer :: idiag_ruz2mx = 0   ! YZAVG_DOC: $\langle\rho u_z^2\rangle_{yz}$
  integer :: idiag_ruxuymx = 0  ! YZAVG_DOC: $\langle\rho u_x u_y\rangle_{yz}$
  integer :: idiag_ruxuzmx = 0  ! YZAVG_DOC: $\langle\rho u_x u_z\rangle_{yz}$
  integer :: idiag_ruyuzmx = 0  ! YZAVG_DOC: $\langle\rho u_y u_z\rangle_{yz}$
  integer :: idiag_ux2mx=0      ! YZAVG_DOC: $\left<u_x^2\right>_{yz}$
  integer :: idiag_uy2mx=0      ! YZAVG_DOC: $\left<u_y^2\right>_{yz}$
  integer :: idiag_uz2mx=0      ! YZAVG_DOC: $\left<u_z^2\right>_{yz}$
  integer :: idiag_ox2mx=0      ! YZAVG_DOC: $\left<\omega_x^2\right>_{yz}$
  integer :: idiag_oy2mx=0      ! YZAVG_DOC: $\left<\omega_y^2\right>_{yz}$
  integer :: idiag_oz2mx=0      ! YZAVG_DOC: $\left<\omega_z^2\right>_{yz}$
  integer :: idiag_uxuymx=0     ! YZAVG_DOC: $\langle u_x u_y\rangle_{yz}$
  integer :: idiag_uxuzmx=0     ! YZAVG_DOC: $\langle u_x u_z\rangle_{yz}$
  integer :: idiag_uyuzmx=0     ! YZAVG_DOC: $\langle u_y u_z\rangle_{yz}$
  integer :: idiag_oumx=0       ! YZAVG_DOC: $\left<\boldsymbol{\omega}
                                ! YZAVG_DOC: \cdot\uv\right>_{yz}$
  integer :: idiag_uguxmx=0     ! YZAVG_DOC:
  integer :: idiag_uguymx=0     ! YZAVG_DOC:
  integer :: idiag_uguzmx=0     ! YZAVG_DOC:
  integer :: idiag_ekinmx=0     ! YZAVG_DOC: $\langle{1\over2}\rho u^2\rangle_{xy}$
  integer :: idiag_fkinxmx=0    ! XYAVG_DOC: $\left<{1\over2}\varrho\uv^2 u_x\right>_{yz}$
!
! y averaged diagnostics given in yaver.in
!
  integer :: idiag_uxmxz=0      ! YAVG_DOC: $\left< u_x \right>_{y}$
  integer :: idiag_uymxz=0      ! YAVG_DOC: $\left< u_y \right>_{y}$
  integer :: idiag_uzmxz=0      ! YAVG_DOC: $\left< u_z \right>_{y}$
  integer :: idiag_ux2mxz=0     ! YAVG_DOC: $\left< u_x^2 \right>_{y}$
  integer :: idiag_uy2mxz=0     ! YAVG_DOC: $\left< u_y^2 \right>_{y}$
  integer :: idiag_uz2mxz=0     ! YAVG_DOC: $\left< u_z^2 \right>_{y}$
  integer :: idiag_uxuymxz=0    ! YAVG_DOC: $\left< u_x u_y \right>_{y}$
  integer :: idiag_uxuzmxz=0    ! YAVG_DOC: $\left< u_x u_z \right>_{y}$
  integer :: idiag_uyuzmxz=0    ! YAVG_DOC: $\left< u_y u_z \right>_{y}$
  integer :: idiag_oumxz=0      ! YAVG_DOC: $\left<\boldsymbol{\omega}
                                ! YAVG_DOC: \cdot\uv\right>_{y}$
!
! z averaged diagnostics given in zaver.in
!
  integer :: idiag_uxmxy=0      ! ZAVG_DOC: $\left< u_x \right>_{z}$
  integer :: idiag_uymxy=0      ! ZAVG_DOC: $\left< u_y \right>_{z}$
  integer :: idiag_uzmxy=0      ! ZAVG_DOC: $\left< u_z \right>_{z}$
  integer :: idiag_uxupmxy=0    ! ZAVG_DOC: $\left< u_{x\uparrow} \right>_{z}$
  integer :: idiag_uxdownmxy=0  ! ZAVG_DOC: $\left< u_{x\downarrow} \right>_{z}$
  integer :: idiag_ruxupmxy=0   ! ZAVG_DOC: $\left<\rho u_{x\uparrow} \right>_{z}$
  integer :: idiag_ruxdownmxy=0 ! ZAVG_DOC: $\left<\rho u_{x\downarrow} \right>_{z}$
  integer :: idiag_ux2upmxy=0   ! ZAVG_DOC: $\left< u^2_{x\uparrow} \right>_{z}$
  integer :: idiag_ux2downmxy=0 ! ZAVG_DOC: $\left< u^2_{x\downarrow} \right>_{z}$
  integer :: idiag_ffdownmxy=0  ! ZAVG_DOC: Filling factor of downflows
  integer :: idiag_uxuymxy=0    ! ZAVG_DOC: $\left< u_x u_y \right>_{z}$
  integer :: idiag_uxuzmxy=0    ! ZAVG_DOC: $\left< u_x u_z \right>_{z}$
  integer :: idiag_uyuzmxy=0    ! ZAVG_DOC: $\left< u_y u_z \right>_{z}$
  integer :: idiag_Rxymxy=0     ! ZAVG_DOC: $\left<u_x' u_y'\right>_{z}$
  integer :: idiag_Rxyupmxy=0   ! ZAVG_DOC: $\left<(u_x' u_y')_\uparrow\right>_{z}$
  integer :: idiag_Rxydownmxy=0 ! ZAVG_DOC: $\left<(u_x' u_y')_\downarrow\right>_{z}$
  integer :: idiag_Rxzmxy=0     ! ZAVG_DOC: $\left<u_x' u_z'\right>_{z}$
  integer :: idiag_Rxzupmxy=0   ! ZAVG_DOC: $\left<(u_x' u_z')_\uparrow\right>_{z}$
  integer :: idiag_Rxzdownmxy=0 ! ZAVG_DOC: $\left<(u_x' u_z')_\downarrow\right>_{z}$
  integer :: idiag_Ryzmxy=0     ! ZAVG_DOC: $\left<u_y' u_z'\right>_{z}$
  integer :: idiag_Ryzupmxy=0   ! ZAVG_DOC: $\left<(u_y' u_z')_\uparrow\right>_{z}$
  integer :: idiag_Ryzdownmxy=0 ! ZAVG_DOC: $\left<(u_y' u_z')_\downarrow\right>_{z}$
  integer :: idiag_oxmxy=0      ! ZAVG_DOC: $\left< \omega_x \right>_{z}$
  integer :: idiag_oymxy=0      ! ZAVG_DOC: $\left< \omega_y \right>_{z}$
  integer :: idiag_ozmxy=0      ! ZAVG_DOC: $\left< \omega_z \right>_{z}$
  integer :: idiag_oumxy=0      ! ZAVG_DOC: $\left<\boldsymbol{\omega}
                                ! ZAVG_DOC: \cdot\uv\right>_{z}$
  integer :: idiag_pvzmxy=0     ! ZAVG_DOC: $\left< (\omega_z+2\Omega)/\varrho
                                ! ZAVG_DOC: \right>_{z}$ \quad(z component of
                                ! ZAVG_DOC: potential vorticity)
  integer :: idiag_uguxmxy=0    ! ZAVG_DOC: $\left< (\boldsymbol{u}\cdot\boldsymbol{\nabla} \boldsymbol{u})_x \right>_{z}$
  integer :: idiag_uguymxy=0    ! ZAVG_DOC: $\left< (\boldsymbol{u}\cdot\boldsymbol{\nabla} \boldsymbol{u})_y \right>_{z}$
  integer :: idiag_uguzmxy=0    ! ZAVG_DOC: $\left< (\boldsymbol{u}\cdot\boldsymbol{\nabla} \boldsymbol{u})_z \right>_{z}$
  integer :: idiag_ruxmxy=0     ! ZAVG_DOC: $\left< \rho u_x \right>_{z}$
  integer :: idiag_ruymxy=0     ! ZAVG_DOC: $\left< \rho u_y \right>_{z}$
  integer :: idiag_ruzmxy=0     ! ZAVG_DOC: $\left< \rho u_z \right>_{z}$
  integer :: idiag_ux2mxy=0     ! ZAVG_DOC: $\left< u_x^2 \right>_{z}$
  integer :: idiag_uy2mxy=0     ! ZAVG_DOC: $\left< u_y^2 \right>_{z}$
  integer :: idiag_uz2mxy=0     ! ZAVG_DOC: $\left< u_z^2 \right>_{z}$
  integer :: idiag_rux2mxy=0    ! ZAVG_DOC: $\left< \rho u_x^2 \right>_{z}$
  integer :: idiag_ruy2mxy=0    ! ZAVG_DOC: $\left< \rho u_y^2 \right>_{z}$
  integer :: idiag_ruz2mxy=0    ! ZAVG_DOC: $\left< \rho u_z^2 \right>_{z}$
  integer :: idiag_ruxuymxy=0   ! ZAVG_DOC: $\left< \rho u_x u_y \right>_{z}$
  integer :: idiag_ruxuzmxy=0   ! ZAVG_DOC: $\left< \rho u_x u_z \right>_{z}$
  integer :: idiag_ruyuzmxy=0   ! ZAVG_DOC: $\left< \rho u_y u_z \right>_{z}$
  integer :: idiag_fkinxmxy=0   ! ZAVG_DOC: $\left<{1\over2}\varrho\uv^2
                                ! ZAVG_DOC: u_x\right>_{z}$
  integer :: idiag_fkinymxy=0   ! ZAVG_DOC: $\left<{1\over2}\varrho\uv^2
                                ! ZAVG_DOC: u_y\right>_{z}$
  integer :: idiag_fkinxupmxy=0 ! ZAVG_DOC: $\left<{1\over2}\varrho\uv^2
                                ! ZAVG_DOC: u_{x\uparrow}\right>_{z}$
  integer :: idiag_fkinxdownmxy=0 ! ZAVG_DOC: $\left<{1\over2}\varrho\uv^2
                                ! ZAVG_DOC: u_{x\downarrow}\right>_{z}$
  integer :: idiag_nshift=0
!
!  Video data.
!
  integer :: ivid_oo=0, ivid_o2=0, ivid_divu=0, ivid_u2=0, ivid_Ma2=0, ivid_uu_sph=0
  integer :: ivid_ou=0
!
!  Auxiliary variables
!
  real, dimension(:,:), pointer :: reference_state
  real, dimension(3) :: Omegav=0.
  real, dimension(nx) :: Fmax,advec_uu=0.
  real :: t_vart=0.
!$omp THREADPRIVATE(advec_uu)
!
  real, dimension (nx) :: prof_amp1, prof_amp2
  real, dimension (mz) :: prof_amp3
  real, dimension (my) :: prof_amp4
  real, dimension (nz,3) :: uumz_prof
  real, dimension (nx,ny) :: omega_prof

  contains
!***********************************************************************
    subroutine register_hydro
!
!  Initialise variables which should know that we solve the hydro
!  equations: iuu, etc; increase nvar accordingly.
!
!  6-nov-01/wolf: coded
! 18-may-12/MR: put Pr*Ra as a shared variable for use in
!               temperature_idealgas
!
      use FArrayManager
      use SharedVariables, only: put_shared_variable
      use Sub, only: register_report_aux
!
!  indices to access uu
!
      call farray_register_pde('uu',iuu,vector=3)
      iux = iuu; iuy = iuu+1; iuz = iuu+2
      if (llinearized_hydro) then
        call farray_register_auxiliary('uu0',iuu0,vector=3)
        iu0x = iuu0; iu0y = iuu0+1; iu0z = iuu0+2
      endif
!
!  Register an extra aux slot for uut if requested. This is needed
!  for calculating the correlation time from <u.intudt>. For this to work
!  you must reserve enough auxiliary workspace by setting, for example,
!     ! MAUX CONTRIBUTION 3
!  in the beginning of your src/cparam.local file, *before* setting
!  ncpus, nprocy, etc.
!  29-oct-20/hongzhe: added uust
!
      if (luut_as_aux) then
        call register_report_aux('uut', iuut, iuxt, iuyt, iuzt)
        ltime_integrals=.true.
      endif
      if (luust_as_aux) then
        call register_report_aux('uust', iuust, iuxst, iuyst, iuzst)
        ltime_integrals=.true.
      endif
      if (loot_as_aux) then
        call register_report_aux('oot', ioot, ioxt, ioyt, iozt)
        ltime_integrals=.true.
      endif
      if (loost_as_aux) then
        call register_report_aux('oost', ioost, ioxst, ioyst, iozst)
        ltime_integrals=.true.
      endif
!
!  omega as aux
!
      !if (loo_as_aux) call register_report_aux('oo', ioo, iox, ioy, ioz, communicated=.true.)
      if (loo_as_aux) call register_report_aux('oo', ioo, iox, ioy, ioz)
!!
!!  Fourier transformed uu as aux
!!
!!     if (luuk_as_aux) call register_report_aux('uuk', iuuk)
!!     if (look_as_aux) call register_report_aux('ook', iook)
!
!  Tij and possibly relativistic Lorentz factor as aux
!
      if (lconservative) then
        call farray_register_auxiliary('Tij',iTij,vector=6,communicated=.true.)
        if (llorentz_as_aux) then
          call register_report_aux('lorentz', ilorentz,communicated=.true.)
        endif
      else
        if (lrelativistic) then
          call fatal_error('register_hydro','no lrelativistic without lconservative')
        else
          if (llorentz_as_aux) call warning('register_hydro', &
              'no Lorentz factor without lconservative or lrelativistic')
        endif
      endif
!
!  To compute the added mass term for particle drag,
!  the advective derivative is needed.
!  The advective derivative is set as an auxiliary
!
      if (ladv_der_as_aux) then
        call farray_register_auxiliary('adv_der_uu',i_adv_der,vector=3)
        i_adv_derx = i_adv_der;  i_adv_dery = i_adv_der+1; i_adv_derz = i_adv_der+2
      endif
!
!  Velocity fluctuation for computation of turbulent Reynolds stress etc.
!  directly in the code.
!
      if (luu_fluc_as_aux) then
        if (iuu_fluc==0) then
          call farray_register_auxiliary('uu_fluc',iuu_fluc,vector=3)
          iuu_flucx = iuu_fluc; iuu_flucy = iuu_fluc+1; iuu_flucz = iuu_fluc+2;
        else
          if (lroot) print*, 'register_hydro: iuu_fluc = ', iuu_fluc
          call farray_index_append('iuu_fluc',iuu_fluc)
        endif
      endif
!
!  Velocity in spherical coordinates from Cartesian simulation, useful
!  for sphere-in-a-box models.
!
      if (luu_sph_as_aux.and.lsphere_in_a_box) then
        if (iuu_sph==0) then
          call farray_register_auxiliary('uu_sph',iuu_sph,vector=3)
          iuu_sphr = iuu_sph; iuu_spht = iuu_sph+1; iuu_sphp = iuu_sph+2;
        else
          if (lroot) print*, 'register_hydro: iuu_sph = ', iuu_sph
          call farray_index_append('iuu_sph',iuu_sph)
        endif
      endif
!
!  For Helmholtz decomposition of uu the potential of the curl-free part is registered  as an auxiliary.
!
      if (lhelmholtz_decomp) then
        !if (dsnap_down==0.) call fatal_error('register_hydro','Helmholtz decomposition requires dsnap_down>0')
        call farray_register_auxiliary('phiuu',iphiuu)
      endif
!
!  Share lpressuregradient_gas so the entropy module knows whether to apply
!  pressure gradient or not. But hydro wants pressure gradient only when
!  the density is computed, i.e. not with lboussinesq nor lanelastic.
!
      if  (.not.ldensity.or.lanelastic) lpressuregradient_gas=.false.
      call put_shared_variable('lpressuregradient_gas', &
          lpressuregradient_gas,caller='register_hydro')
!
!  Special settings for lboussinesq.
!
      if  (lboussinesq) then
        PrRa=Pr*Ra
        call put_shared_variable('PrRa',PrRa)
        call put_shared_variable('Pr',Pr)
      endif
!
!  Identify version number (generated automatically by SVN).
!
      if (lroot) call svn_id( &
           "$Id$")
!
!  Writing files for use with IDL.
!
      if (lroot) then
        if (maux == 0) then
          if (nvar < mvar) write(4,*) ',uu $'
          if (nvar == mvar) write(4,*) ',uu'
        else
          write(4,*) ',uu $'
        endif
        write(15,*) 'uu = fltarr(mx,my,mz,3)*one'
      endif
!
!  shared variable of lconservative for density
!
      call put_shared_variable('lconservative',lconservative, caller='register_hydro')
!
! If we are to solve for gradient of dust particle velocity, we must store gradient
! of gas velocity as auxiliary
!
      if (lparticles_grad) lgradu_as_aux=.true.
      if (lSGS_hydro) call register_SGS_hydro
!
    endsubroutine register_hydro
!***********************************************************************
    subroutine initialize_hydro(f)
!
!  Perform any post-parameter-read initialization i.e. calculate derived
!  parameters.
!
!  24-nov-02/tony: coded
!  13-oct-03/dave: check parameters and warn (if nec.) about velocity damping
!  26-mar-10/axel: lreinitialize_uu added
!  23-dec-15/MR: Cartesian vector Omegav intro'd; ltime_integrals set; rotation
!                of \vec{Omega} on Yang grid added.
!   7-jun.16/MR: modifications for calculation of z average on Yin-Yang grid, not yet operational
!
      use BorderProfiles, only: request_border_driving
      use Initcond
      use SharedVariables, only: put_shared_variable, get_shared_variable
      use Sub, only: step, erfunc, register_report_aux
      use Slices_methods, only: alloc_slice_buffers
      use Yinyang_mpi, only: initialize_zaver_yy
!
      real, dimension (mx,my,mz,mfarray) :: f
      real, dimension (mz) :: c, s
      integer :: j,myl ! currently unused: nycap
      real :: slope,uinn,uext,zbot
!
! set the right point in profile to unity.
!
      profile_SH(index_rSH)=dx_1(index_rSH)
!
!  Block use of uninitalised p%fcont
!
      if (.not.lforcing_cont) lforcing_cont_uu=.false.
!
!  Calculate cosz*sinz, cos^2, and sinz^2, to take moments with
!  of ux2, uxuy, etc.
!
      cx10=cos(10*x(l1:l2))
      sx10=sin(10*x(l1:l2))
      c=cos(kz_analysis*z)
      s=sin(kz_analysis*z)
      cz=c
      sz=s
      c2z=c**2
      s2z=s**2
!
!  Rescale velocity by a factor reinitialize_uu.
!
      if (lreinitialize_uu) then
        do j=1,ninit
          select case (inituu(j))
          case ('Beltrami-z'); call beltrami(ampluu(j),f,iuu,kz=kz_uu)
          case ('rescale'); f(:,:,:,iux:iuz)=rescale_uu*f(:,:,:,iux:iuz)
          case ('gaussian-noise'); call gaunoise(ampluu(j),f,iux,iuz)
          case ('gaussian-noise-z'); call gaunoise(ampluu(j),f,iuz)
          case ('no-uy'); f(:,:,:,iuy)=0.
          case ('flip-ux'); f(:,:,:,iux)=-f(:,:,:,iux)
          case ('flip-uy'); f(:,:,:,iuy)=-f(:,:,:,iuy)
          case ('mult-uz-lower-xbdry'); if (ipx==0) f(1:l1,:,:,iuz)=rescale_uu*f(1:l1,:,:,iuz)
          case ('Om_inner'); f(:,:,:,iuz)=Om_inner*spread(spread(xyz0(1)**2/x,2,my)*spread(sin(y),1,mx),3,mz)
          endselect
        enddo
      endif
!
      ! Default value of 'tfade_start' is tdamp/2 for faded damping
      if (.not. ldamp_fade .and. (tfade_start >= 0.0) .and. (tdamp > 0.0)) ldamp_fade = .true.
      if (ldamp_fade .and. (tfade_start == -1.0)) tfade_start = 0.5 * tdamp
      if (ldamp_fade .and. (tfade_start >= tdamp) .and. (tdamp > 0.0)) &
          call fatal_error ('initialize_hydro', 'Please set tfade_start < tdamp')
      call put_shared_variable ('dampu', dampu, caller='initialize_hydro')
      call put_shared_variable ('tdamp', tdamp)
      call put_shared_variable ('ldamp_fade', ldamp_fade)
      call put_shared_variable ('tfade_start', tfade_start)
!
!  r_int and r_ext override rdampint and rdampext if both are set
!
      if (dampuint /= 0.) then
        if (r_int > epsi) then
          rdampint = r_int
        elseif (rdampint <= epsi) then
          write(*,*) 'initialize_hydro: inner radius not yet set, dampuint= ',dampuint
        endif
      endif

      if (Omega/=0.) then
!
!  defining an r-dependent profile for Omega. The Coriolis force will be suppressed
!  in r < r_omega with the width w_omega, for having the supression for r> r_omega,
!  choose a negativ w_omega.
!
        prof_om = 1.0
        if (r_omega /= 0.0) &
          prof_om = step(x(l1:l2),r_omega,w_omega)
!
!  Cartesian components of \vec{Omega} (not yet used).
!
        if (lyang) then
          Omegav(1) = -Omega*sin(theta*dtor)*cos(phi*dtor)
          Omegav(2) = -Omega*cos(theta*dtor)
          Omegav(3) = -Omega*sin(theta*dtor)*sin(phi*dtor)
        else
          Omegav(1) = Omega*sin(theta*dtor)*cos(phi*dtor)
          Omegav(2) = Omega*sin(theta*dtor)*sin(phi*dtor)
          Omegav(3) = Omega*cos(theta*dtor)
        endif
      endif
!
!  damping parameters for damping velocities outside an embedded sphere
!  04-feb-2008/dintrans: corrected because otherwise rdampext=r_ext all the time
!
      if (dampuext /= 0.0) then
!       if (r_ext < impossible) then
!         rdampext = r_ext
!       elseif (rdampext == impossible) then
!         write(*,*) 'initialize_hydro: outer radius not yet set, dampuext= ',dampuext
!       endif
        if (rdampext == impossible) then
          if (r_ext < impossible) then
            if (lroot) write(*,*) 'initialize_hydro: set outer radius rdampext=r_ext'
            rdampext = r_ext
          else
            if (lroot) write(*,*) 'initialize_hydro: cannot set outer radius rdampext=r_ext'
          endif
        else
          if (lroot) write(*,*) 'initialize_hydro: outer radius rdampext=',rdampext
        endif
      endif
!
!  Calculate inverse damping times for damping momentum in the
!  x and y directions.
!
      if (tau_damp_ruxm /= 0.) tau_damp_ruxm1=1./tau_damp_ruxm
      if (tau_damp_ruym /= 0.) tau_damp_ruym1=1./tau_damp_ruym
      if (tau_damp_ruzm /= 0.) tau_damp_ruzm1=1./tau_damp_ruzm
!
!  Set freezing arrays.
!
      if (lfreeze_uint) lfreeze_varint(iux:iuz) = .true.
      if (lfreeze_uext) lfreeze_varext(iux:iuz) = .true.
!
!  Turn off advection for 0-D runs.
!
      if (nwgrid==1) then
        ladvection_velocity=.false.
        if (lroot) print*, &
             'initialize_hydro: 0-D run, turned off advection of velocity'
      endif
!
!  Border profile backward compatibility. For a vector, if only the first
!  borderuu is set, then the other components get the same value.
!
      if (lpropagate_borderuu     .and. &
           borderuu(1)/='nothing' .and. &
           borderuu(2)=='nothing' .and. &
           borderuu(3)=='nothing') then
        borderuu(2)=borderuu(1)
        borderuu(3)=borderuu(1)
      endif
!
!  Tell the BorderProfiles module if we intend to use border driving, so
!  that the module can request the right pencils.
!
      do j=1,3
        if (borderuu(j)/='nothing') call request_border_driving(borderuu(j))
      enddo
!
!  Hand over Coriolis force to Particles_drag.
!
      drag: if (lparticles_drag .and. lcoriolis_force) then
        lcoriolis_force = .false.
        if (lroot) print *, 'initialize_hydro: turned off and hand over Coriolis force to Particles_drag. '
      endif drag
!
      lshear_in_coriolis=lshear_in_coriolis.and.lcoriolis_force.and.lshear
!
!  Compute mask for x-averaging where x is in hydro_xaver_range.
!  Normalize such that the average over the full domain
!  gives still unity.
!
      if (l1 == l2) then
        xmask_hyd = 1.
      else
        where (x(l1:l2) >= hydro_xaver_range(1) .and. x(l1:l2) <= hydro_xaver_range(2))
          xmask_hyd = 1.
        elsewhere
          xmask_hyd = 0.
        endwhere
        hydro_xaver_range(1) = max(hydro_xaver_range(1), xyz0(1))
        hydro_xaver_range(2) = min(hydro_xaver_range(2), xyz1(1))
        if (lspherical_coords) then
          xmask_hyd = xmask_hyd * (xyz1(1)**3 - xyz0(1)**3) &
              / (hydro_xaver_range(2)**3 - hydro_xaver_range(1)**3)
        elseif (lcylindrical_coords) then
          xmask_hyd = xmask_hyd * (xyz1(1)**2 - xyz0(1)**2) &
              / (hydro_xaver_range(2)**2 - hydro_xaver_range(1)**2)
        else
          xmask_hyd = xmask_hyd*Lxyz(1) &
              / (hydro_xaver_range(2) - hydro_xaver_range(1))
        endif
      endif
!
!  Compute mask for z-averaging where z is in hydro_zaver_range.
!  Normalize such that the average over the full domain
!  gives still unity.
!
      if (n1 == n2) then
        zmask_hyd = 1.
      else
        where (z(n1:n2) >= hydro_zaver_range(1) .and. z(n1:n2) <= hydro_zaver_range(2))
          zmask_hyd = 1.
        elsewhere
          zmask_hyd = 0.
        endwhere
        hydro_zaver_range(1) = max(hydro_zaver_range(1), xyz0(3))
        hydro_zaver_range(2) = min(hydro_zaver_range(2), xyz1(3))
        zmask_hyd = zmask_hyd*Lxyz(3)/(hydro_zaver_range(2) - hydro_zaver_range(1))
      endif
!
!  debug output
!
      if (lroot.and.ip<14) then
        print*,'xmask_hyd=',xmask_hyd
        print*,'zmask_hyd=',zmask_hyd
      endif
!
      if (force_lower_bound == 'vel_time' .or. force_upper_bound == 'vel_time') then
        call put_shared_variable('ampl_forc', ampl_forc)
        call put_shared_variable('k_forc', k_forc)
        call put_shared_variable('w_forc', w_forc)
        call put_shared_variable('x_forc', x_forc)
        call put_shared_variable('dx_forc', dx_forc)
      endif

      call put_shared_variable('lshear_rateofstrain',lshear_rateofstrain)
!
!  Check if we are solving the force-free equations in parts of domain.
!  This is currently possible with density (including anelastic, but not
!  boussinesq).
!
      if (ldensity) then
        call get_shared_variable('lffree',lffree)
        if (lffree) then
          call get_shared_variable('profx_ffree',profx_ffree)
          call get_shared_variable('profy_ffree',profy_ffree)
          call get_shared_variable('profz_ffree',profz_ffree)
        endif
      endif
!
      if (lviscosity) call put_shared_variable ('lcalc_uuavg',lcalc_uuavg)
!
!  Get the reference state if requested
!
      if (lreference_state) &
        call get_shared_variable('reference_state',reference_state)
!
      lcalc_uumeanz = lcalc_uumeanz .or. lcalc_uumean .or. ltestfield_xz .or. &      ! lcalc_uumean for compatibility
                      lremove_uumeanz .or. lremove_uumeanz_horizontal .or. lSchur_3D3D1D_uu
      lcalc_uumeanx = lcalc_uumeanx.or.lremove_uumeanx
      lcalc_uumeany = lcalc_uumeany.or.lremove_uumeany
      lcalc_uumeanxy = lcalc_uumeanxy .or. lremove_uumeanxy.or.ltestfield_xy.or.lSchur_2D2D3D_uu
!
      if (lremove_uumeanz.or.lremove_uumeanx.or.lremove_uumeany) then
        if (lremove_mean_flow) call warning('initialize_hydro', &
            'lremove_mean_flow=T may interfere with lremove_uumean[xyz]=T')
        if (lremove_mean_momenta) call warning('initialize_hydro', &
            'lremove_mean_momenta=T may interfere with lremove_uumean[xyz]=T')
        if (lremove_uumeanxy) call warning('initialize_hydro', &
            'lremove_uumeanxy=T may interfere with lremove_uumean[xyz]=T')
      endif
!
      if (Omega/=0. .and. lyinyang) then
        if (phi==0.) then
!
!  Rotate \vec{Omega} on Yang grid.
!
          if (lyang) then
            Omega = -Omega
            phi   = 90.-theta
            theta = 90.
          endif
        else
          call fatal_error('initialize_hydro', 'phi /= 0. not allowed for Yin-Yang grid')
        endif
      endif
!
      if (lcalc_uumeanxy .or. lcalc_ruumeanxy) then
        myl=my
        if (lyinyang) then
          call fatal_error('initialize_hydro','Calculation of z average not implmented for Yin-Yang')
          !call initialize_zaver_yy(myl,nycap)
        endif
        allocate(uumxy(mx,myl,3))
        allocate(ruumxy(mx,myl,3))
        uumxy=0.0
        ruumxy=0.0
      endif
!
!  Preparations for adding/removing mean flows.
!  Set profiles for forcing differential rotation.
!
      select case (uuprof)

      case ('BS04')
        if (wdamp/=0.) then
          prof_amp1=1.-step(x(l1:l2),rdampint,wdamp)
        else
          prof_amp1=1.
        endif
        prof_amp1=ampl1_diffrot*prof_amp1*cos(kx_diffrot*x(l1:l2))**xexp_diffrot
        prof_amp3=cos(z)

      case ('BS04c','BS04c1','HP09')

        if (wdamp/=0.) then
          prof_amp3=ampl1_diffrot*0.5*(1.+tanh((z-rdampint)/(wdamp)))
        else
          prof_amp3=ampl1_diffrot
        endif

        if (uuprof=='BS04c') then
          prof_amp1=sin(0.5*pi*((x(l1:l2))-x0)/Lx)**xexp_diffrot
        elseif (uuprof=='BS04c1') then
          prof_amp1=sin(pi*((x(l1:l2))-x0)/Lx)**xexp_diffrot
        elseif(uuprof=='HP09') then
          prof_amp1=cos(kx_diffrot*x(l1:l2))
!or       prof_amp1=cos(2.*pi*kx_diffrot*(x(l1:l2)-x0)/Lx)
        endif

      case ('BS04m')
        if (wdamp/=0.) then
          prof_amp1=1.-step(x(l1:l2),rdampint,wdamp)
        else
          prof_amp1=1.
        endif
        prof_amp1=ampl1_diffrot*prof_amp1*sin((pi/(2.*x(l2)))*x(l1:l2))
        prof_amp4=cos(pi/(2.*y(m2))*y)

      case ('solar_DC99')
        prof_amp1=(1.-ampl1_diffrot*step(x(l1:l2),rdampext,wdamp))*step(x(l1:l2),rdampint,wdamp)*x(l1:l2)
        prof_amp4=ampl2_diffrot*(1.064-0.145*costh**2-0.155*costh**4-1.)*sinth

      case ('vertical_shear')
        zbot=xyz0(3)
        prof_amp3=ampl1_diffrot*cos(kz_diffrot*(z-zbot)-phase_diffrot)

      case ('vertical_compression','vertical_shear_x')
        zbot=xyz0(3)
        prof_amp3=ampl1_diffrot*cos(kz_diffrot*(z-zbot))

      case ('remove_vertical_shear')
        if (.not.lcalc_uumean) &
          call fatal_error("initialize_hydro","you need to set lcalc_uumean=T for uuprof='remove_vertical_shear'")

      case ('vertical_shear_x_sinz')
        zbot=xyz0(3)
        where (z <= 0.) 
          prof_amp3=ampl1_diffrot*sin(.5*pi/abs(zbot)*z)
        elsewhere
          prof_amp3=0.
        endwhere

      case ('vertical_shear_z')
        prof_amp3=ampl1_diffrot*tanh((z-rdampint)/width_ff_uu)

      case ('vertical_shear_z2')
        if (.not.lcalc_uumeanxz) &
          call fatal_error("initialize_hydro","you need to set lcalc_uumeanxz=T for uuprof='vertical_shear_z2'")
        prof_amp3=ampl1_diffrot*tanh((z-rdampint)/width_ff_uu)

      case ('vertical_shear_linear')
        if (.not.lcalc_uumeanxz) &
          call fatal_error("initialize_hydro","you need to set lcalc_uumeanxz=T for uuprof='vertical_shear_linear'")
        prof_amp3=ampl1_diffrot*z

      case ('tachocline')
        if (wdamp/=0.) then
          prof_amp1=1.-step(x(l1:l2),rdampint,wdamp)
        else
          prof_amp1=1.
        endif
      case ('solar_simple')
        if (lspherical_coords) then
          prof_amp1=ampl1_diffrot*step(x(l1:l2),x1_ff_uu,width_ff_uu)
          prof_amp4=1.5-7.5*costh*costh
        elseif (lcartesian_coords) then
          prof_amp1=ampl1_diffrot*cos(x(l1:l2))
          prof_amp4=cos(y)*cos(y)
        !prof_amp2=1.-step(x(l1:l2),x2_ff_uu,width_ff_uu)
        else
          call fatal_error("initialize_hydro", &
                          "uuprof='solar_simple' not implemented for other than spherical or Cartesian coordinates") 
        endif
      case ('radial_uniform_shear')
        uinn = omega_in*x(l1)
        uext = omega_out*x(l2)
        slope = (uext - uinn)/(x(l2)-x(l1))
        prof_amp1=slope*x(l1:l2)+(uinn*x(l2)- uext*x(l1))/(x(l2)-x(l1))

      case ('breeze')
        prof_amp3=ampl_wind*z/(2.*pi)

      case ('slow_wind')
        prof_amp3=ampl_wind*(1.+tanh((z-rdampext)/wdamp))

      case ('radial_shear')
        if (.not.lcalc_uumeanxy) &
          call fatal_error("initialize_hydro","you need to set lcalc_uumeanxy=T for uuprof='radial_shear'")
        prof_amp1=ampl1_diffrot*cos(2*pi*k_diffrot*(x(l1:l2)-x0)/Lx)

      case ('radial_shear_damp')
        if (.not.lcalc_uumeanxy) &
          call fatal_error("initialize_hydro","you need to set lcalc_uumeanxy=T for uuprof='radial_shear_damp'")
        prof_amp1=ampl1_diffrot*tanh((x(l1:l2)-rdampint)/wdamp)

      case ('damp_corona')
        if (lspherical_coords) then
          if (.not.lcalc_uumeanxy) &
            call fatal_error("initialize_hydro","you need to set lcalc_uumeanxy=T for uuprof='damp_corona'")
          prof_amp1=0.5*(tanh((x(l1:l2)-rdampext)/wdamp)+1.)
        elseif (lcartesian_coords) then
          zbot=xyz0(3)
          prof_amp3=0.5*(tanh((z-zbot)/wdamp)+1.)
        endif

      case ('damp_horiz_vel')
        prof_amp3=0.5*(tanh((z-rdampext)/wdamp)+1.)

      case ('latitudinal_shear')
        if (.not.lcalc_uumeanxy) &
          call fatal_error("initialize_hydro","you need to set lcalc_uumeanxy=T for uuprof='latitudinal_shear'")
        prof_amp4=ampl1_diffrot*cos(2.*pi*k_diffrot*(y-y0)/Ly)

      case ('damp_jets')
        if (.not.lcalc_uumeanxy) &
          call fatal_error("initialize_hydro","you need to set lcalc_uumeanxy=T for uuprof='damp_jets'")
        prof_amp4=1.-0.5*(1.+tanh((y-(y0+ydampint))/wdamp)-(1.+tanh((y-(y0+Lxyz(2)-ydampext))/wdamp)))

      case ('spoke-like-NSSL')
        if (.not.lspherical_coords) &
          call warning("initialize_hydro", &
                       "uuprof='spoke-like-NSSL' only meningful for spherical coordinates")
        if (.not.lcalc_uumeanxy) &
          call fatal_error("initialize_hydro","you need lcalc_uumeanxy=T for uuprof='spoke-like-NSSL'")

        prof_amp1=ampl1_diffrot*x(l1:l2)
        profx_diffrot1=+0.5*(1.+erfunc(((x(l1:l2)-uphi_rbot)/uphi_step_width)))
        profx_diffrot2=+0.5*(1.-erfunc(((x(l1:l2)-uphi_rtop)/uphi_step_width)))
        profx_diffrot3=+0.5*(1.+erfunc(((x(l1:l2)-uphi_rtop)/uphi_step_width)))
        profx_diffrot2=(x(l1:l2)-uphi_rbot)*profx_diffrot1*profx_diffrot2 !(redefined)
        profy_diffrot1=-1.5*(5.*costh**2-1.)
        profy_diffrot2=-1.0*(4.*costh**2-3.)
        profy_diffrot3=-1.0
        profz_diffrot1=+1.
!
      case ('uumz_profile')
        if (.not.lcalc_uumeanz) then
          call fatal_error("initialize_hydro","you need to set lcalc_uumean=T for uuprof='uumz_profile'")
        else
          if (.not.lgravz) &
            call fatal_error("initialize_hydro","gravitation in z-direction (lgravz=T) needed for uuprof='uumz_profile'")
          call read_uumz_profile(uumz_prof)
        endif

      case ('omega_profile')
        if (.not.lspherical_coords) &
          call warning("initialize_hydro", &
                       "uuprof='omega_profile' only meaningful for spherical coordinates")
        if (.not.lcalc_uumeanxy) &
          call fatal_error("initialize_hydro","you need to set lcalc_uumeanxy=T for uuprof='omega_profile'")
        call read_omega_profile(omega_prof)

      case ('nothing')

      case default
         if (lroot) print*,'initialize_hydro: No profile of mean flow "'//trim(uuprof)//'"'

      endselect
!
      if (ivid_oo/=0) call alloc_slice_buffers(oo_xy,oo_xz,oo_yz,oo_xy2,oo_xy3,oo_xy4,oo_xz2,oo_r)
      if (ivid_o2/=0) call alloc_slice_buffers(o2_xy,o2_xz,o2_yz,o2_xy2,o2_xy3,o2_xy4,o2_xz2,o2_r)
      if (ivid_ou/=0) call alloc_slice_buffers(ou_xy,ou_xz,ou_yz,ou_xy2,ou_xy3,ou_xy4,ou_xz2,ou_r)
      if (ivid_u2/=0) call alloc_slice_buffers(u2_xy,u2_xz,u2_yz,u2_xy2,u2_xy3,u2_xy4,u2_xz2,u2_r)
      if (ivid_divu/=0) call alloc_slice_buffers(divu_xy,divu_xz,divu_yz,divu_xy2,divu_xy3,divu_xy4,divu_xz2,divu_r)
      if (ivid_Ma2/=0) call alloc_slice_buffers(mach_xy,mach_xz,mach_yz,mach_xy2,mach_xy3,mach_xy4,mach_xz2,mach_r)
      if (ivid_uu_sph/=0) &
        call alloc_slice_buffers(uu_sph_xy,uu_sph_xz,uu_sph_yz,uu_sph_xy2,uu_sph_xy3,uu_sph_xy4,uu_sph_xz2,uu_sph_r)
!
!  give warning if orms is not set in prints.in
!
      if (othresh_per_orms/=0..and.idiag_orms==0) then
        if (lroot) print*,'calc_othresh: need to set orms in print.in to get othresh.'
      endif
!
      if (lSGS_hydro) call initialize_SGS_hydro
!
!  Check if we are solving the relativistic eos equations.
!  In that case we'd need to get lrelativistic_eos from density.
!  But this only makes sense when we are are not already fully relativistic.
!
      if (ldensity) &
        call get_shared_variable('lrelativistic_eos', lrelativistic_eos)
!
!  Get B_ext2 from magnetic module.
!
      if (lmagnetic.and.lconservative) call get_shared_variable('B_ext2',B_ext2)
!
      endsubroutine initialize_hydro
!***********************************************************************
      subroutine calc_means_hydro(f)
!
! calculates various means
!
!  14-oct-13/MR: outsourced from hydro_after_boundary
!  13-feb-15/MR: changes for use of reference_state
!
      use Mpicomm, only: mpiallreduce_sum
      use Sub, only: finalize_aver
      use Deriv, only: der_z
      use DensityMethods, only: getrho
      use Yinyang_mpi, only: zsum_yy
!
      real, dimension (mx,my,mz,mfarray), intent(IN) :: f
!
      real, dimension (nx) :: rho,rux,ruy,ruz
      integer, parameter :: nreduce=3
      real, dimension (nreduce) :: fsum_tmp,fsum
      real, dimension (:,:,:), allocatable :: buffer
      real :: fact
      integer :: j,nnz,l,m,n
!
!  calculate averages of rho*ux and rho*uy
!
      if (ldensity) then
        if (tau_damp_ruxm/=0. .or. tau_damp_ruym/=0. .or. tau_damp_ruzm/=0.) then
          ruxm=0.
          ruym=0.
          ruzm=0.
          fact=1./nwgrid
          do n=n1,n2
          do m=m1,m2
            call getrho(f(:,m,n,ilnrho),rho)
            rux=rho*f(l1:l2,m,n,iux)
            ruy=rho*f(l1:l2,m,n,iuy)
            ruz=rho*f(l1:l2,m,n,iuz)
            ruxm=ruxm+fact*sum(rux)
            ruym=ruym+fact*sum(ruy)
            ruzm=ruzm+fact*sum(ruz)
          enddo
          enddo
!
!  communicate to the other processors
!
          fsum_tmp(1)=ruxm
          fsum_tmp(2)=ruym
          fsum_tmp(3)=ruzm
          call mpiallreduce_sum(fsum_tmp,fsum,nreduce)
          ruxm=fsum(1)
          ruym=fsum(2)
          ruzm=fsum(3)
        endif
      endif
!
!  do xy-averaged mean flow for each component
!
      if (lcalc_uumeanz) then
        fact=1./nxygrid
        do nnz=1,mz
          do j=1,3
            uumz(nnz,j)=fact*sum(f(l1:l2,m1:m2,nnz,iux+j-1))
          enddo
        enddo
        call finalize_aver(nprocxy,12,uumz)
      endif
!
!  do xy-averaged mean momentum for each component
!
      if (lcalc_ruumeanz) then
        fact=1./nxygrid
        do nnz=1,mz
          do j=1,3
            ruumz(nnz,j)=fact*sum(exp(f(l1:l2,m1:m2,nnz,ilnrho))*f(l1:l2,m1:m2,nnz,iux+j-1))
          enddo
        enddo
        call finalize_aver(nprocxy,12,ruumz)
!
      endif
!
!  do yz-averaged mean flow for each component
!
      if (lcalc_uumeanx) then
        fact=1./nyzgrid
        do l=1,mx
          do j=1,3
            uumx(l,j)=fact*sum(f(l,m1:m2,n1:n2,iux+j-1))
          enddo
        enddo
        call finalize_aver(nprocyz,23,uumx)
      endif
!
!  do xz-averaged mean flow for each component
!
      if (lcalc_uumeany) then
        fact=1./nxzgrid
        do m=1,my
          do j=1,3
            uumy(m,j)=fact*sum(f(l1:l2,m,n1:n2,iux+j-1))
          enddo
        enddo
        call finalize_aver(nprocxz,13,uumy)
      endif
!
!  Do mean 2D field in (x,y)-plane for each component
!
      if (lcalc_uumeanxy) then
!
        fact=1./nzgrid_eff
        if (lyang) allocate(buffer(1,mx,my))
        do j=1,3
          if (lyang) then
!
!  On Yang grid:
!
            do n=n1,n2
              do m=1,my
                call zsum_yy(buffer,1,m,n,f(:,m,n,iuu+j-1))
              enddo
            enddo
            uumxy(:,:,j)=fact*buffer(1,:,:)
          else
!
! Normal summing-up in Yin procs.
!
            uumxy(:,:,j)=fact*sum(f(:,:,n1:n2,iuu+j-1),3)  ! requires equidistant grid
          endif
        enddo
        call finalize_aver(nprocz,3,uumxy)
!
      endif
!
!  Do mean 2D momentum in (x,y)-plane for each component
!
      if (lcalc_ruumeanxy) then
!
        fact=1./nzgrid_eff
        if (lyang) allocate(buffer(1,mx,my))
        do j=1,3
          if (lyang) then
!
!  On Yang grid:
!
            do n=n1,n2
              do m=1,my
                call zsum_yy(buffer,1,m,n,exp(f(:,m,n,ilnrho))*f(:,m,n,iuu+j-1))
              enddo
            enddo
            ruumxy(:,:,j)=fact*buffer(1,:,:)
          else
!
! Normal summing-up in Yin procs.
!
            ruumxy(:,:,j)=fact*sum(exp(f(:,:,n1:n2,ilnrho))*f(:,:,n1:n2,iuu+j-1),3)  ! requires equidistant grid
          endif
        enddo
        call finalize_aver(nprocz,3,ruumxy)
!
      endif
!
!  Do mean 2D field in (x,z)-plane for each component
!
      if (lcalc_uumeanxz) then
!
        uumxz = sum(f(:,m1:m2,:,iux:iuz),2)/nygrid
        call finalize_aver(nprocy,2,uumxz)
!
      endif
!
!  do communication for array of size nz*nprocz*3*njtest
!
!     if (nprocy>1) then
!       uum2=reshape(uumz1,shape=(/nz*nprocz*3/))
!       call mpireduce_sum(uumz2,uum3,(/nz,nprocz,3/))
!       call mpibcast_real(uumz3,nz*nprocz*3)
!       uum1=reshape(uum3,shape=(/nz,nprocz,3/))
!       do n=n1,n2
!         do j=1,3
!           uumz(n,j)=uumz1(n-n1+1,ipz+1,j)
!         enddo
!       enddo
!     endif
!
      endsubroutine calc_means_hydro
!***********************************************************************
    subroutine init_uu(f)
!
!  initialise velocity field ; called from start.f90
!
!  07-nov-01/wolf: coded
!  24-nov-02/tony: renamed for consistence (i.e. init_[variable name])
!  13-feb-15/MR: changes for use of reference_state
!
      use Boundcond, only: update_ghosts
      use Density, only: beta_glnrho_scaled
      use DensityMethods, only: getrho, putlnrho
      use EquationOfState, only: cs20
      use General
      use Gravity, only: gravz_const,z1
      use Initcond
      use InitialCondition, only: initial_condition_uu
      use Sub
      use Mpicomm, only: lyang
!
      real, dimension (mx,my,mz,mfarray) :: f
      real, dimension (3) :: tmpvec
!
      real, dimension (nx,3) :: tmp_nx3
      real, dimension (mx,3) :: ss
      real, dimension (mx) :: tmpmx, ss2
      real, dimension (nx) :: r,p1,tmp,prof,xc0,yc0,ur,lnrhor
      real, dimension (:,:), allocatable :: yz
      real :: kabs,crit,eta_sigma,tmp0,phi0
      real :: a2, rr2, wall_smoothing
      real :: dis, xold,yold,uprof, factx, factz, sph, sph_har_der, der
      integer :: j,i,l,ixy,ix,iy,iz,iz0,iyz,iter,niter=100
      logical :: lvectorpotential=.false.
!
!  inituu corresponds to different initializations of uu (called from start).
!
      f(:,:,:,iux:iuz)=0.
      do j=1,ninit
!
        select case (inituu(j))
!
        case ('nothing'); if (lroot .and. j==1) print*,'init_uu: nothing'
        case ('zero', '0')
          if (lroot) print*,'init_uu: zero velocity'
          ! Ensure really is zero, as may have used lread_oldsnap
          f(:,:,:,iux:iuz)=0.
        case ('const_uu','const-uu'); do i=1,3; f(:,:,:,iuu+i-1) = uu_const(i); enddo
        case('smooth_step_ux')
          xhalf= 0.5*(xyz1(1)+xyz0(1))
          do iy=m1,m2;do iz=n1,n2
            f(:,iy,iz,iuy)= -ampluu(j)+2.*ampluu(j)*step(x,xhalf,widthuu)
          enddo;enddo
        case('parabola_x')
          do ix=l1,l2;do iy=m1,m2;do iz=n1,n2
            f(ix,iy,iz,iuu)=0
            f(ix,iy,iz,iuu+1)=max_uu*(1-(x(ix)/x(l1))**2)
            f(ix,iy,iz,iuu+2)=0
          enddo;enddo;enddo
        case ('mode'); call modev(ampluu(j),coefuu,f,iuu,kx_uu,ky_uu,kz_uu)
        case ('ortho')
          do ix=l1,l2;do iy=m1,m2;do iz=n1,n2
            f(ix,iy,iz,iuu)=-2.*ampluu(j)*sin(y(iy))
            f(ix,iy,iz,iuu+1)=ampluu(j)*sin(x(ix))
            f(ix,iy,iz,iuu+2)=0.001*ampluu(j)*sin(y(iy))
          enddo;enddo;enddo
        case ('Kolmogorov-x')
          do iy=m1,m2; do iz=n1,n2
            f(:,iy,iz,iuy)=ampluu(j)*cos(kx_uu*x)
          enddo; enddo
        case ('Kolmogorov-x-perturb')
          print*,'ampluu,kx_uu,amp_factor,kx_uu_perturb',ampluu,kx_uu,amp_factor,kx_uu_perturb
          do iy=m1,m2; do iz=n1,n2
            f(:,iy,iz,iuy)=ampluu(j)*(cos(kx_uu*x)+amp_factor*cos(kx_uu_perturb*x))
          enddo; enddo
        case ('uxsinx-deltaz')
          iz0=nint((zsphere-xyz0(3))/dz)
          print*, 'Ux=sin(kx*x)\delta(z)'
          print*, 'ampluu,kx_uu,zsphere,iz0',ampluu,kx_uu,zsphere,iz0
          print*, 'dz=',dz
          f(:,:,:,iux:iuz) = 0.
          do ix=l1,l2
             if ((iz0 .le. n2) .and. (iz0 .gt. n1) )  &
             f(ix,:,iz0,iux) = ampluu(j)*sin(kx_uu*x(ix))
          enddo
        case ('random_isotropic_shell')
          call random_isotropic_shell(f,iux,ampluu(j),z1_uu,z2_uu)
        case ('gaussian-noise'); call gaunoise(ampluu(j),f,iux,iuz)
        case ('gaussian-noise-x'); call gaunoise(ampluu(j),f,iux)
        case ('gaussian-noise-y'); call gaunoise(ampluu(j),f,iuy)
        case ('gaussian-noise-z'); call gaunoise(ampluu(j),f,iuz)
        case ('gaussian-noise-xy'); call gaunoise(ampluu(j),f,iux,iuy)
        case ('gaussian-noise-rprof')
          call gaunoise_rprof(ampluu(j),f,iux,iuz,rnoise_int,rnoise_ext)
        case ('xjump')
          call jump(f,iux,uu_left,uu_right,widthuu,'x')
          call jump(f,iuy,uy_left,uy_right,widthuu,'x')
        case ('Beltrami-x'); call beltrami(ampluu(j),f,iuu,kx=kx_uu,sigma=relhel_uu)
        case ('Beltrami-y'); call beltrami(ampluu(j),f,iuu,ky=ky_uu,sigma=relhel_uu)
        case ('Beltrami-z'); call beltrami(ampluu(j),f,iuu,kz=kz_uu,sigma=relhel_uu)
        case ('Straining'); call straining(ampluu(j),f,iuu,kx_uu,ky_uu,kz_uu,dimensionality)
        case ('rolls'); call rolls(ampluu(j),f,iuu,kx_uu,kz_uu)
        case ('trilinear-x'); call trilinear(f,iux,ampl_ux(j),ampl_uy(j),ampl_uz(j))
        case ('trilinear-y'); call trilinear(f,iuy,ampl_ux(j),ampl_uy(j),ampl_uz(j))
        case ('trilinear-z'); call trilinear(f,iuz,ampl_ux(j),ampl_uy(j),ampl_uz(j))
        case ('cos-cos-sin-uz'); call cos_cos_sin(ampluu(j),f,iuz)
        case ('tor_pert'); call tor_pert(ampluu(j),f,iux)
        case ('rotblob'); call rotblob(ampluu(j),incl_alpha,f,iux,rot_rr,xsphere,ysphere,zsphere)
        case ('rotblob_yz'); call rotblob_yz(ampluu(j),f,iux,rot_rr,xsphere,ysphere,zsphere)
        case ('read_arr_file'); call read_outside_vec_array(f, "uu.arr", iuu)
        case ('diffrot'); call diffrot(ampluu(j),f,iuy)
        case ('olddiffrot'); call olddiffrot(ampluu(j),f,iuy)
        case ('sinwave-phase')
          call sinwave_phase(f,iux,ampl_ux(j),kx_ux(j),ky_ux(j),kz_ux(j),phase_ux(j))
          call sinwave_phase(f,iuy,ampl_uy(j),kx_uy(j),ky_uy(j),kz_uy(j),phase_uy(j))
          call sinwave_phase(f,iuz,ampl_uz(j),kx_uz(j),ky_uz(j),kz_uz(j),phase_uz(j))
        case ('coswave-phase')
          call coswave_phase(f,iux,ampl_ux(j),kx_ux(j),ky_ux(j),kz_ux(j),phase_ux(j))
          call coswave_phase(f,iuy,ampl_uy(j),kx_uy(j),ky_uy(j),kz_uy(j),phase_uy(j))
          call coswave_phase(f,iuz,ampl_uz(j),kx_uz(j),ky_uz(j),kz_uz(j),phase_uz(j))
        case ('sinwave-x'); call sinwave(ampluu(j),f,iux,kx=kx_uu)
        case ('sinwave-y'); call sinwave(ampluu(j),f,iuy,ky=ky_uu)
        case ('sinwave-z'); call sinwave(ampluu(j),f,iuz,kz=kz_uu)
        case ('sinwave-ux-kx'); call sinwave(ampluu(j),f,iux,kx=kx_uu)
        case ('sinwave-ux-ky'); call sinwave(ampluu(j),f,iux,ky=ky_uu)
        case ('sinwave-ux-kz'); call sinwave(ampluu(j),f,iux,kz=kz_uu)
        case ('sinwave-uy-kx'); call sinwave(ampluu(j),f,iuy,kx=kx_uu)
        case ('sinwave-uy-ky'); call sinwave(ampluu(j),f,iuy,ky=ky_uu)
        case ('sinwave-uy-kz'); call sinwave(ampluu(j),f,iuy,kz=kz_uu)
        case ('sinwave-uz-kx'); call sinwave(ampluu(j),f,iuz,kx=kx_uu)
        case ('sinwave-uz-ky'); call sinwave(ampluu(j),f,iuz,ky=ky_uu)
        case ('sinwave-uz-kz'); call sinwave(ampluu(j),f,iuz,kz=kz_uu)
        case ('sinwave-y-z')
          if (lroot) print*, 'init_uu: sinwave-y-z, ampluu=', ampluu(j)
          call sinwave(ampluu(j),f,iuy,kz=kz_uu)
        case ('sinwave-z-y')
          if (lroot) print*, 'init_uu: sinwave-z-y, ampluu=', ampluu(j)
          call sinwave(ampluu(j),f,iuz,ky=ky_uu)
        case ('sinwave-z-x')
          if (lroot) print*, 'init_uu: sinwave-z-x, ampluu=', ampluu(j)
          call sinwave(ampluu(j),f,iuz,kx=kx_uu)
        case ('damped_sinwave-z-x')
          if (lroot) print*, 'init_uu: damped_sinwave-z-x, ampluu=', ampluu(j)
          do m=m1,m2; do n=n1,n2
            f(:,m,n,iuz)=f(:,m,n,iuz)+ampluu(j)*sin(kx_uu*x)*exp(-10*z(n)**2)
          enddo; enddo
        !case ('hatwave-x'); call hatwave(ampluu(j),f,iux,widthuu,kx=kx_uu,power=initpower)
        case ('45deg-sinwave-x-y')
          if (lroot) print*, 'init_uu: 45deg_sinwave-x-y, ampluu=', ampluu(j)
          do m=m1,m2; do n=n1,n2
            f(:,m,n,iux)=f(:,m,n,iux)+ampluu(j)*sin(kx_uu*x+ky_uu*y(m))
            f(:,m,n,iuy)=f(:,m,n,iuy)+ampluu(j)*sin(kx_uu*x+ky_uu*y(m))
          enddo; enddo
        case ('45deg-sinwave-y-z')
          if (lroot) print*, 'init_uu: 45deg_sinwave-y-z, ampluu=', ampluu(j)
          do m=m1,m2; do n=n1,n2
            f(:,m,n,iuy)=f(:,m,n,iuy)+ampluu(j)*sin(ky_uu*y(m)+kz_uu*z(n))
            f(:,m,n,iuz)=f(:,m,n,iuz)+ampluu(j)*sin(ky_uu*y(m)+kz_uu*z(n))
          enddo; enddo
        case ('coswave-x'); call coswave(ampluu(j),f,iux,kx=kx_uu,ky=ky_uu,kz=kz_uu)
        case ('coswave-y'); call coswave(ampluu(j),f,iuy,kx=kx_uu,ky=ky_uu,kz=kz_uu)
        case ('coswave-z'); call coswave(ampluu(j),f,iuz,kz=kz_uu)
        case ('coswave-x-z'); call coswave(ampluu(j),f,iux,kz=kz_uu)
        case ('coswave-z-x'); call coswave(ampluu(j),f,iuz,kx=kx_uu)
        case ('x1cosycosz'); call x1_cosy_cosz(ampluu(j),f,iuy,ky=ky_uu,kz=kz_uu)
        case ('couette'); call couette(ampluu(j),mu_omega,f,iuy)
        case ('couette_rings'); call couette_rings(ampluu(j),mu_omega,nb_rings,om_rings,gap,f,iuy)
        case ('soundwave-x'); call soundwave(ampluu(j),f,iux,kx=kx_uu,width=widthuu)
        case ('soundwave-y'); call soundwave(ampluu(j),f,iuy,ky=ky_uu)
        case ('soundwave-z'); call soundwave(ampluu(j),f,iuz,kz=kz_uu)
        case ('robertsflow'); call robertsflow(ampluu(j),f,iuu,relhel_uu)
        case ('hawley-et-al'); call hawley_etal99a(ampluu(j),f,iuy,Lxyz)
        case ('meri_circ'); call meri_circ(f)
        case ('sound-wave', '11')
!
!  sound wave (should be consistent with density module)
!
          if (lroot) print*,'init_uu: x-wave in uu; ampluu(j)=',ampluu(j)
          do n=n1,n2; do m=m1,m2
            f(l1:l2,m,n,iux)=uu_const(1)+ampluu(j)*sin(kx_uu*x(l1:l2))
          enddo; enddo
!
        case ('sound-wave2')
!
!  sound wave (should be consistent with density module)
!
          crit=cs20-gravz_const/kx_uu**2
          if (lroot) print*,'init_uu: x-wave in uu; crit,ampluu(j)=',crit,ampluu(j)
          do n=n1,n2; do m=m1,m2
            if (crit>0.) then
              f(l1:l2,m,n,iux)=+ampluu(j)*cos(kx_uu*x(l1:l2))*sqrt(abs(crit))
            else
              f(l1:l2,m,n,iux)=-ampluu(j)*sin(kx_uu*x(l1:l2))*sqrt(abs(crit))
            endif
          enddo; enddo
!
        case ('ABC')
          if (headtt) print*,'ABC flow'
! uu
          do n=n1,n2; do m=m1,m2
            f(l1:l2,m,n,iux)=ampluu(j)*(ABC_A*sin(kz_uu*z(n))    +ABC_C*cos(ky_uu*y(m))    )
            f(l1:l2,m,n,iuy)=ampluu(j)*(ABC_B*sin(kx_uu*x(l1:l2))+ABC_A*cos(kz_uu*z(n))    )
            f(l1:l2,m,n,iuz)=ampluu(j)*(ABC_C*sin(ky_uu*y(m))    +ABC_B*cos(kx_uu*x(l1:l2)))
          enddo; enddo
!
        case ('Schur_3D3D1D')
          if (headtt) print*,'Schur_3D3D1D flow'
! uu
          do n=n1,n2; do m=m1,m2
            f(l1:l2,m,n,iux)=ampluu(j)*sin(2.*kx_uu*x(l1:l2))*sin(2.*ky_uu*y(m))*sin(2.*kz_uu*z(n))
            f(l1:l2,m,n,iuy)=ampluu(j)*cos(2.*kx_uu*x(l1:l2))*cos(2.*ky_uu*y(m))*sin(2.*kz_uu*z(n))
            f(l1:l2,m,n,iuz)=ampluu(j)*5                                        *cos(3.*kz_uu*z(n))
          enddo; enddo
!
        case ('Schur_2D2D3D')
          if (headtt) print*,'Schur_2D2D3D flow'
! uu
          do n=n1,n2; do m=m1,m2
            f(l1:l2,m,n,iux)= ampluu(j)*cos(kx_uu*x(l1:l2))*sin(ky_uu*y(m))
            f(l1:l2,m,n,iuy)=-ampluu(j)*sin(kx_uu*x(l1:l2))*cos(ky_uu*y(m))
            f(l1:l2,m,n,iuz)= ampluu(j)*sin(kx_uu*x(l1:l2))*sin(ky_uu*y(m))*cos(kz_uu*z(n))
          enddo; enddo
!
        case ('Schur_neutral')
          if (headtt) print*,'Schur_neutral init flow'
! uu
          do n=n1,n2; do m=m1,m2
            f(l1:l2,m,n,iux)= ampluu(j)*cos(kx_uu*x(l1:l2))*sin(ky_uu*y(m))
            f(l1:l2,m,n,iuy)=-ampluu(j)*sin(kx_uu*x(l1:l2))*cos(ky_uu*y(m))
            f(l1:l2,m,n,iuz)= ampluu(j)*sin(kx_uu*x(l1:l2))*sin(ky_uu*y(m))
          enddo; enddo
!
        case ('Schur_helical')
          if (headtt) print*,'Schur_helical init flow'
! uu
          do n=n1,n2; do m=m1,m2
            f(l1:l2,m,n,iux)= 0.5*ampluu(j)*(1.4*cos(kx_uu*x(l1:l2))*sin(ky_uu*y(m))+ &
                                                 sin(kx_uu*x(l1:l2))*cos(ky_uu*y(m)))
            f(l1:l2,m,n,iuy)=-0.5*ampluu(j)*(1.4*sin(kx_uu*x(l1:l2))*cos(ky_uu*y(m))+ &
                                                 cos(kx_uu*x(l1:l2))*sin(ky_uu*y(m)))
            f(l1:l2,m,n,iuz)= 0.5*ampluu(j)*(1.4*sin(kx_uu*x(l1:l2))*sin(ky_uu*y(m))- &
                                              2.*cos(kx_uu*x(l1:l2))*cos(ky_uu*y(m)))
          enddo; enddo
!
        case ('double_sine')
          if (headtt) print*,'double sine flow'
! uu
          do n=n1,n2; do m=m1,m2
            f(l1:l2,m,n,iux)=ampluu(j)*(ABC_A*sin(kz_uu*z(n))    +ABC_C*sin(ky_uu*y(m))    )
            f(l1:l2,m,n,iuy)=ampluu(j)*(ABC_B*sin(kx_uu*x(l1:l2))+ABC_A*sin(kz_uu*z(n))    )
            f(l1:l2,m,n,iuz)=ampluu(j)*(ABC_C*sin(ky_uu*y(m))    +ABC_B*sin(kx_uu*x(l1:l2)))
          enddo; enddo
!
        case ('shock-tube', '13')
!
!  shock tube test (should be consistent with density module)
!
          if (lroot) print*,'init_uu: polytopic standing shock'
          do n=n1,n2; do m=m1,m2
            prof=.5*(1.+tanh(x(l1:l2)/widthuu))
            f(l1:l2,m,n,iux)=uu_left+(uu_right-uu_left)*prof
          enddo; enddo
!
        case ('tanhx')
!
!  Burgers shock
!
          if (lroot) print*,'init_uu: Burgers shock'
          prof=-ampluu(j)*tanh(.5*x(l1:l2)/widthuu)
          do n=n1,n2; do m=m1,m2
            f(l1:l2,m,n,iux)=prof
          enddo; enddo
!
        case ('tanhy')
!
!  A*tanh(y/d) profile in the x-direction
!
          if (lroot) print*,'init_uu: tangential discontinuity'
          do m=m1,m2
            prof=ampluu(j)*tanh(y(m)/widthuu)
            do n=n1,n2
              f(l1:l2,m,n,iux)=prof
            enddo
          enddo
!
        case ('double_shear_layer')
!
!  Double shear layer
!
          if (lroot) print*,'init_uu: Double shear layer'
          do m=m1,m2
            der=2./delta_u
            prof=ampluu(j)*(&
                tanh(der*(y(m)+widthuu))-&
                tanh(der*(y(m)-widthuu)))/2.
            do n=n1,n2
              f(l1:l2,m,n,iux)=prof
            enddo
          enddo
!
        case ('cos_exp_perturbed')

          if (lroot) print*,'init_uu: tanhy_perturbed'
          do l=l1,l2;  do m=m1,m2
            uprof=amp_factor*cos(kx_uu*x(l))*exp(-abs(y(m))/widthuu)
            do n=n1,n2
              f(l,m,n,iuy)=uprof
              f(l,m,n,iux)=0.0
            enddo
          enddo; enddo
!
        case ('sin_exp_perturbed')

          if (lroot) print*,'init_uu: tanhy_perturbed'
          do l=l1,l2;  do m=m1,m2
            uprof=amp_factor*sin(kx_uu*x(l))*exp(-abs(y(m))/widthuu)
            do n=n1,n2
              f(l,m,n,iuy)=uprof
              f(l,m,n,iux)=0.0
            enddo
          enddo; enddo
!
        case ('tanhy_perturbed')
!
!  A*( tanh(y/d)+amp_factor*sin(kx_uu*x)*exp(-abs(y/d)) ) profile in the x-direction
!
          if (lroot) print*,'init_uu: tanhy_perturbed'
          do l=l1,l2;  do m=m1,m2
            uprof=ampluu(j)*tanh(y(m)/widthuu)
            do n=n1,n2
              f(l,m,n,iux)=uprof
            enddo
            uprof=amp_factor*sin(kx_uu*x(l))*exp(-abs(y(m))/widthuu)
!            uprof=0.0001*sin(94.2477796*x(l))*exp(-0.1*abs(y(m))/widthuu)
            do n=n1,n2
              f(l,m,n,iuy)=uprof
            enddo
          enddo; enddo
!
        case ('shock-sphere')
!
!  shock tube test (should be consistent with density module)
!
          if (lroot) print*,'init_uu: spherical shock, widthuu=',widthuu,' radiusuu=',radiusuu
          do n=n1,n2; do m=m1,m2
            f(l1:l2,m,n,iux)=0.5*x(l1:l2)/radiusuu*ampluu(j)*(1.-tanh((sqrt(x(l1:l2)**2+y(m)**2+z(n)**2)-radiusuu)/widthuu))
            f(l1:l2,m,n,iuy)=0.5*y(m)/radiusuu*ampluu(j)*(1.-tanh((sqrt(x(l1:l2)**2+y(m)**2+z(n)**2)-radiusuu)/widthuu))
            f(l1:l2,m,n,iuz)=0.5*z(n)/radiusuu*ampluu(j)*(1.-tanh((sqrt(x(l1:l2)**2+y(m)**2+z(n)**2)-radiusuu)/widthuu))
          enddo; enddo
!
!
        case ('bullets')
!
!  blob-like velocity perturbations (bullets)
!
          if (lroot) print*,'init_uu: velocity blobs'
          do n=n1,n2; do m=m1,m2
            f(l1:l2,m,n,iuz)=f(l1:l2,m,n,iuz)+ampluu(j)*exp(-(x(l1:l2)**2+y(m)**2+z(n)**2)/widthuu)
          enddo; enddo
!
!  blob-like velocity perturbations in x-direction (bullets)
!
        case ('bullets_x')
          if (lroot) print*,'init_uu: velocity blobs in x-direction'
          do n=n1,n2; do m=m1,m2
            f(l1:l2,m,n,iux)=uu_const(1)+f(l1:l2,m,n,iux) &
              +ampluu(j)*exp(-((x(l1:l2)-xsphere)**2+ &
                                   (y(m)-ysphere)**2+ &
                                   (z(n)-zsphere)**2)/widthuu**2)
          enddo; enddo
!
!  blob-like velocity perturbations in x-direction (bullets)
!
        case ('bullets_xz_plane')
          factx=ampluu(j)*sin(uu_xz_angle(j)*pi/180.)
          factz=ampluu(j)*cos(uu_xz_angle(j)*pi/180.)
          if (lroot) print*,'init_uu: velocity blobs in xz-plane'
          do n=n1,n2; do m=m1,m2
            tmp=exp(-((x(l1:l2)-xsphere)**2+ &
              (y(m)-ysphere)**2+(z(n)-zsphere)**2)/widthuu**2)
            f(l1:l2,m,n,iux)=f(l1:l2,m,n,iux)+factx*tmp
            f(l1:l2,m,n,iuz)=f(l1:l2,m,n,iuz)+factz*tmp
          enddo; enddo
!
!  X-point, xy plane
!
        case ('x-point_xy')
          if (lroot) print*,'init_uu: X-point'
          do n=n1,n2; do m=m1,m2
            f(l1:l2,m,n,iux)=f(l1:l2,m,n,iux)+ampluu(j)*x(l1:l2)
            f(l1:l2,m,n,iuy)=f(l1:l2,m,n,iuy)-ampluu(j)*y(m)
          enddo; enddo
!
!  X-point, xz plane
!
        case ('x-point_xz')
          if (lroot) print*,'init_uu: X-point'
          do n=n1,n2; do m=m1,m2
            f(l1:l2,m,n,iux)=f(l1:l2,m,n,iux)+ampluu(j)*x(l1:l2)
            f(l1:l2,m,n,iuz)=f(l1:l2,m,n,iuz)-ampluu(j)*z(n)
          enddo; enddo
!
        case ('Alfven-circ-x')
!
!  circularly polarised Alfven wave in x direction
!
          do n=n1,n2; do m=m1,m2
          if (lroot) print*,'init_uu: circular Alfven wave -> x'
            f(l1:l2,m,n,iuy) = f(l1:l2,m,n,iuy) + ampluu(j)*sin(kx_uu*x(l1:l2))
            f(l1:l2,m,n,iuz) = f(l1:l2,m,n,iuz) + ampluu(j)*cos(kx_uu*x(l1:l2))
          enddo; enddo
!
        case ('coszsiny-uz')
          do n=n1,n2; do m=m1,m2
            f(l1:l2,m,n,iuz)=f(l1:l2,m,n,iuz)- &
                ampluu(j)*cos(pi*z(n)/Lxyz(3))*sin(2*pi*y(m)/Lxyz(2))
          enddo; enddo
!
        case ('siny/x2')
          do n=n1,n2; do m=m1,m2
            f(l1:l2,m,n,iuy)=f(l1:l2,m,n,iuy)+ &
                ampluu(j)*sin(y(m))/x(l1:l2)**2
          enddo; enddo
!
        case ('linear-shear')
!
!  Linear shear
!
          if (lroot) print*,'init_uu: linear-shear, ampluu=', ampluu(j)
          do l=l1,l2; do m=m1,m2
            f(l,m,n1:n2,iuy) = ampluu(j)*z(n1:n2)
          enddo; enddo
!
        case ('linear-x_shear-uy')
          if (lroot) print*,'init_uu: linear-x_shear-uy, ampluu=', ampluu(j)
          do n=n1,n2; do m=m1,m2
            f(l1:l2,m,n,iuy) = ampluu(j)*x(l1:l2)
          enddo; enddo
!
        case ('tanh-x-z')
          if (lroot) print*, &
              'init_uu: tanh-x-z, widthuu, ampluu=', widthuu, ampluu(j)
          do l=l1,l2; do m=m1,m2
            f(l,m,n1:n2,iux) = ampluu(j)*tanh(z(n1:n2)/widthuu)
          enddo; enddo
!
        case ('tanh-y-z')
          if (lroot) print*, &
              'init_uu: tanh-y-z, widthuu, ampluu=', widthuu, ampluu(j)
          do l=l1,l2; do m=m1,m2
            f(l,m,n1:n2,iuy) = ampluu(j)*tanh(z(n1:n2)/widthuu)
          enddo; enddo
!
        case ('gauss-x-z')
          if (lroot) print*, &
              'init_uu: gauss-x-z, widthuu, ampluu=', widthuu, ampluu(j)
          do l=l1,l2; do m=m1,m2
            f(l,m,n1:n2,iux) = ampluu(j)*exp(-z(n1:n2)**2/widthuu**2)
          enddo; enddo
!
        case ('const-ux')
!
!  constant x-velocity
!
          if (lroot) print*,'init_uu: constant x-velocity'
          f(:,:,:,iux) = ampluu(j)
!
        case ('const-uy')
!
!  constant y-velocity
!
          if (lroot) print*,'init_uu: constant y-velocity'
          f(:,:,:,iuy) = ampluu(j)
!
        case ('const-uz')
!
!  constant z-velocity
!
          if (lroot) print*,'init_uu: constant z-velocity'
          f(:,:,:,iuz) = ampluu(j)
!
        case ('omega-z')
!
!  constant x-velocity
!
          if (lroot) print*,'init_uu: constant angular velocity omega_ini=',omega_ini
          f(:,:,:,iux) = 0
          f(:,:,:,iuy) = 0
          do n=n1,n2
            do m=m1,m2
              f(l1:l2,m,n,iuz) = omega_ini*x(l1:l2)*sinth(m)
            enddo
          enddo
!
        case ('tang-discont-z')
!
!  tangential discontinuity: velocity is directed along x,
!  ux=uu_lower for z<0 and ux=uu_upper for z>0. This can
!  be set up together with 'rho-jump' in density.
!
          if (lroot) print*,'init_uu: tangential discontinuity of uux at z=0'
          if (lroot) print*,'init_uu: uu_lower=',uu_lower,' uu_upper=',uu_upper
          if (lroot) print*,'init_uu: widthuu=',widthuu
          do n=n1,n2; do m=m1,m2
            prof=.5*(1.+tanh(z(n)/widthuu))
            f(l1:l2,m,n,iux)=uu_lower+(uu_upper-uu_lower)*prof
!
!  Add some random noise to see the development of instability
!WD: Can't we incorporate this into the urand stuff?
            print*, 'init_uu: ampluu(j)=',ampluu(j)
            call random_number_wrapper(r)
            call random_number_wrapper(p1)
!          tmp=sqrt(-2*log(r))*sin(2*pi*p1)*exp(-z(n)**2*10.)
            tmp=exp(-z(n)**2*10.)*cos(2.*x(l1:l2)+sin(4.*x(l1:l2)))
            f(l1:l2,m,n,iuz)=f(l1:l2,m,n,iuz)+ampluu(j)*tmp
          enddo; enddo
!
        case ('Fourier-trunc')
!
!  truncated simple Fourier series as nontrivial initial profile
!  for convection. The corresponding stream function is
!    exp(-(z-z1)^2/(2w^2))*(cos(kk)+2*sin(kk)+3*cos(3kk)),
!    with kk=k_x*x+k_y*y
!  Not a big success (convection starts much slower than with
!  random or 'up-down') ..
!
          if (lroot) print*,'init_uu: truncated Fourier'
          do n=n1,n2; do m=m1,m2
            prof = ampluu(j)*exp(-0.5*(z(n)-z1)**2/widthuu**2)!vertical Gaussian
            tmp = kx_uu*x(l1:l2) + ky_uu*y(m)                 ! horizontal phase
            kabs = sqrt(kx_uu**2+ky_uu**2)
            f(l1:l2,m,n,iuz) = prof * kabs*(-sin(tmp) + 4*cos(2*tmp) - 9*sin(3*tmp))
            tmp = (z(n)-z1)/widthuu**2*prof*(cos(tmp) + 2*sin(2*tmp) + 3*cos(3*tmp))
            f(l1:l2,m,n,iux) = tmp*kx_uu/kabs
            f(l1:l2,m,n,iuy) = tmp*ky_uu/kabs
          enddo; enddo
!
        case ('up-down')
!
!  flow upwards in one spot, downwards in another; not soneloidal
!
          if (lroot) print*,'init_uu: up-down'
          do n=n1,n2; do m=m1,m2

            prof = ampluu(j)*exp(-0.5*(z(n)-z1)**2/widthuu**2) ! vertical profile

            tmp = sqrt((x(l1:l2)-(x0+0.3*Lx))**2+(y(m)-(y0+0.3*Ly))**2)! dist. from spot 1
            f(l1:l2,m,n,iuz) = prof*exp(-0.5*(tmp**2)/widthuu**2)

            tmp = sqrt((x(l1:l2)-(x0+0.5*Lx))**2+(y(m)-(y0+0.8*Ly))**2)! dist. from spot 1
            f(l1:l2,m,n,iuz) = f(l1:l2,m,n,iuz) - 0.7*prof*exp(-0.5*(tmp**2)/widthuu**2)

          enddo; enddo
!
        case ('powern')
! initial spectrum k^power
          call powern(ampluu(j),initpower,cutoff,f,iux,iuz)
!
! initial spectrum k^power
!
        case ('power_randomphase')
          call power_randomphase(ampluu(j),initpower,kgaussian_uu,kpeak,cutoff,f,iux,iuz,lscale_tobox)
!
! initial spectrum k^power
!
        case ('power_randomphase_hel')
          call power_randomphase_hel(ampluu(j),initpower,initpower2, &
            cutoff,ncutoff,kpeak,f,iux,iuz,relhel_uu,kgaussian_uu, &
            lskip_projection, lvectorpotential,lscale_tobox, &
            nfact0=nfact_uu, lfactors0=lfactors_uu, &
            lno_noise=lno_noise_uu, qirro=qirro_uu)
!
        case ('random-isotropic-KS')
          call random_isotropic_KS(initpower,f,iux,N_modes_uu)
!
        case ('vortex_2d')
! Vortex solution of Goodman, Narayan, & Goldreich (1987)
          call vortex_2d(f,b_ell,widthuu,rbound)
!
        case ('sub-Keplerian')
          if (lroot) print*, 'init_hydro: set sub-Keplerian gas velocity'
          f(:,:,:,iux) = f(:,:,:,iux) - 1/(2*Omega)*cs20*beta_glnrho_scaled(2)
          f(:,:,:,iuy) = f(:,:,:,iuy) + 1/(2*Omega)*cs20*beta_glnrho_scaled(1)
          ! superimpose here for the case of pressure bump special module chaning f as well
!
        case ('rigid')
          do n=n1,n2; do m=m1,m2; do l=l1,l2
            if (x(l)**2+y(m)**2+z(n)**2<=radiusuu**2) then
              f(l,m,n,iux)=-ampluu(j)*y(m)
              f(l,m,n,iuy)=+ampluu(j)*x(l)
            endif
          enddo; enddo; enddo
!
!  compressive (non-vortical) shear wave of Johnson & Gammie (2005a)
!
        case ('compressive-shwave')
          if (ldensity.or.lanelastic) then
            call coswave_phase(f,iux,ampl_ux(j),kx_uu,ky_uu,kz_uu,phase_ux(j))
            call coswave_phase(f,iuy,ampl_uy(j),kx_uu,ky_uu,kz_uu,phase_uy(j))
            eta_sigma = (2. - qshear)*Omega
            do n=n1,n2; do m=m1,m2
              tmp = -kx_uu*ampl_uy(j)*eta_sigma* &
                    (cos(kx_uu*x(l1:l2)+ky_uu*y(m)+kz_uu*z(n)) + &
                     sin(kx_uu*x(l1:l2)+ky_uu*y(m)+kz_uu*z(n)))
              call putlnrho(f(:,m,n,ilnrho),tmp)
            enddo; enddo
          endif
        case ( 'random-2D-eddies')
          if (lroot) &
            print*, "random-2D-eddies: ampluu,kx_uu,ky_uu = ", ampluu(j),kx_uu,ky_uu
          f(:,:,:,iuz)=0.
          call random_number_wrapper(xc0)
! Introduce both counter clockwise and clockwise eddies
          do ixy=1,neddy
            if (xc0(ixy)<=0.5) then
              tmp(ixy)=-1.0
            else
              tmp(ixy)=1.0
            endif
          enddo
!
          call random_number_wrapper(xc0)
          xc0=(1.-2*xc0)*Lxyz(1)/2
          call random_number_wrapper(yc0)
          yc0=(1.-2*yc0)*Lxyz(2)/2
! need to initialize xold, yold
! bing: suggestion use pos of last eddy
          xold = xc0(neddy)
          yold = yc0(neddy)
!
          do n=n1,n2; do m=m1,m2
! Check for nearest neighbour eddies and change their sign
            do ixy=1,neddy
              dis=sqrt((xold-xc0(ixy))**2+(yold-yc0(ixy))**2)
              if (dis<5*sqrt(1./kx_uu**2+1./ky_uu**2)) then
                tmp(ixy)=-tmp(ixy-1)
                if (lroot) &
                  write(*,*) 'init_uu: random-2D-eddies have come very close!'
              endif
              f(l1:l2,m,n,iuz)=f(l1:l2,m,n,iuz)+tmp(ixy)*ampluu(j) &
              *exp(-kx_uu*(x(l1:l2)-xc0(ixy))**2-ky_uu*(y(m)-yc0(ixy))**2) &
              *exp(-kz_uu*z(n)**2)
!
              xold=xc0(ixy)
              yold=yc0(ixy)
            enddo
          enddo; enddo
          call update_ghosts(f)
! 2D curl
          do n=n1,n2;do m=m1,m2
            call grad(f,iuz,tmp_nx3)
            f(l1:l2,m,n,iux) = -tmp_nx3(:,2)
            f(l1:l2,m,n,iuy) =  tmp_nx3(:,1)
          enddo;enddo
          f(:,:,:,iuz)=0.
          do m=m1,m2
            call random_number_wrapper(f(l1:l2,m,n1,iuz))
            do n=n1,n2
              if (louinit) then
                f(l1:l2,m,n,iuz)=100*ampluu(j)*(2*f(l1:l2,m,n1,iuz)-1)
              else
                f(l1:l2,m,n,iuz)=0.0d0
              endif
            enddo
          enddo
!  Transformation-reflection x -> -x and ux -> -ux
          if (lreflecteddy) then
           do iz=1,mz; do iy=1,my;do ix=1, mx/2
              tmpvec = f(mx-ix+1,iy,iz,iux:iuz)
              f(mx-ix+1,iy,iz,iux)= -f(ix,iy,iz,iux)
              f(ix,iy,iz,iux)=-tmpvec(1)
              f(mx-ix+1,iy,iz,iuy)= f(ix,iy,iz,iuy)
              f(ix,iy,iz,iuy)=tmpvec(2)
              f(mx-ix+1,iy,iz,iuz)= f(ix,iy,iz,iuz)
              f(ix,iy,iz,iuz)=tmpvec(3)
            enddo; enddo; enddo
          endif
          close(15)
!
        case ( 'anelastic-nlin')
          print*, "anelastic-2dxz: ampl_uy,kx_uu,kz_uu = ", ampl_uy(j),kx_uu,ky_uu,kz_uu
          do n=n1,n2; do m=m1,m2
            f(l1:l2,m,n,iuy)=ampl_uy(j)*exp(-kx_uu*x(l1:l2)**2-kz_uu*z(n)**2)
          enddo; enddo
          call update_ghosts(f)
! 2D curl
          do n=n1,n2;do m=m1,m2
            call grad(f,iuy,tmp_nx3)
            call getrho(f(:,m,n,ilnrho),tmp)
            f(l1:l2,m,n,iux) = -tmp_nx3(:,3)/tmp
            f(l1:l2,m,n,iuz) =  tmp_nx3(:,1)/tmp
          enddo;enddo
          f(:,:,:,iuy)=0.
!
        case ( 'anelastic-lin')
          print*, "anelastic-2dxz: ampl_ux,kx_uu,kz_uu = ", ampl_ux(j),kx_uu,kz_uu
          f(:,:,:,iuy)=0.
          do n=n1,n2; do m=m1,m2
            f(l1:l2,m,n,iux)=ampl_ux(j)*sin(x(l1:l2))*cos(z(n))
            f(l1:l2,m,n,iuz)=-ampl_ux(j)*cos(x(l1:l2))*sin(z(n))
          enddo; enddo
          f(:,:,:,iuz)=0.   !!!
!
        case ('incompressive-shwave')
! incompressible shear wave of Johnson & Gammine (2005a)
          print*, "incomp-shwave: ampl_ux/ky_uu = ", ampl_ux(j)/ky_uu
! Get the streamfunction, save it in the iuz slot
          call sinwave_phase(f,iuz,ampl_ux(j)/ky_uu,&
              kx_uu,ky_uu,kz_uu,phase_ux(j))
! Set the boundaries before taking the curl
          call update_ghosts(f)
! 2D curl
          do n=n1,n2;do m=m1,m2
            call grad(f,iuz,tmp_nx3)
            f(l1:l2,m,n,iux) = -tmp_nx3(:,2)
            f(l1:l2,m,n,iuy) =  tmp_nx3(:,1)
          enddo;enddo
          f(:,:,:,iuz)=0.
!
        case ('cylcoords-stream-x')
! Constant velocity in x-direction in cylinder coordinates
          do l=l1,l2; do m=m1,m2
            wall_smoothing=1-exp(-((x(l)-r_cyl)/skin_depth)**2)
            f(l,m,:,iux)=cos(y(m))*ampluu(j)*wall_smoothing
            f(l,m,:,iuy)=-sin(y(m))*ampluu(j)*wall_smoothing
          enddo; enddo
          f(:,:,:,iuz)=0.
          f(1:l1,:,:,iux:iuz)=0.
!
        case ('cylinderstream_cyl')
!   Stream functions for flow around a cylinder as initial condition.
!   Cylindrical coordinates. Flow in x-direction.
          a2 = r_cyl**2
          do l=l1,l2
            if (x(l) < r_cyl) then
              f(l,:,:,iux:iuz) = 0
            else
              rr2 = x(l)**2
              wall_smoothing=1-exp(-((x(l)-r_cyl)/skin_depth)**2)
              do m=m1,m2
                f(l,m,:,iux) = ampluu(j)*cos(y(m))&
                               *(1. - a2/rr2)*wall_smoothing
                f(l,m,:,iuy) = -ampluu(j)*sin(y(m))&
                               *(1. + a2/rr2)*wall_smoothing
              enddo
            endif
          enddo
!
        case('Gressel-hs')
          call information('init_uu', &
              'Gressel hydrostatic equilibrium setup done in interstellar')
!
        case('spher-harm-poloidal')
!
!  Poloidal flow, defined by spherical harmonic ll_sh(j), mm_sh(j) 
!  and radial profile of the generating scalar tmp, depending on n_xprof(j) (see below)
!
          if (.not.lspherical_coords) call fatal_error("init_uu", &
              "spher-harm-poloidal only meaningful for spherical coordinates")

          if (n_xprof(j)==-1) then
            tmp=(x(l1:l2)-xyz0(1))*(x(l1:l2)-xyz1(1))                 ! parabola, vanishing at top and bottom
            prof=tmp/x(l1:l2) + 2.*x(l1:l2)-(xyz0(1)+xyz1(1))         ! f/r + d f/dr
          else
            tmp=sin((2.*pi/(Lxyz(1))*n_xprof(j))*(x(l1:l2)-xyz0(1)))  ! sine with wavenumber n_xprof(j)
            prof=tmp/x(l1:l2) + (2.*pi/(Lxyz(1))*n_xprof(j))*cos((2.*pi/(Lxyz(1))*n_xprof(j))*(x(l1:l2)-xyz0(1)))
          endif

          if (lyang) then
            allocate(yz(2,ny*nz))
            call yin2yang_coors(costh(m1:m2),sinth(m1:m2),cosph(n1:n2),sinph(n1:n2),yz)
            iyz=1
            do m=m1,m2
              do n=n1,n2
                sph=ampluu(j)*ylm_other(yz(1,iyz),yz(2,iyz),ll_sh(j),mm_sh(j),sph_har_der)
                tmp_nx3(:,1)=2.*tmp*sph
                tmp_nx3(:,2)=ampluu(j)*prof*sph_har_der
                if (mm_sh(j)/=0) then
                  tmp_nx3(:,3) = -sph*prof*mm_sh(j)/sin(yz(1,iyz))*sin(mm_sh(j)*yz(2,iyz))/cos(mm_sh(j)*yz(2,iyz))
                else
                  tmp_nx3(:,3) = 0.
                endif
                call transform_thph_yy( tmp_nx3, (/1,1,1/), f(l1:l2,m,n,iux:iuz), yz(1,iyz), yz(2,iyz) )
                iyz=iyz+1
              enddo
            enddo
          else
            do n=n1,n2
              do m=m1,m2
                sph=ampluu(j)*ylm(ll_sh(j),mm_sh(j),sph_har_der)
                f(l1:l2,m,n,iux) = ll_sh(j)*(ll_sh(j)+1)*tmp*sph
                f(l1:l2,m,n,iuy) = ampluu(j)*prof*sph_har_der
                if (mm_sh(j)/=0) &      ! tb improved!
                  f(l1:l2,m,n,iuz) = -prof*sph*mm_sh(j)/sinth(m)* sin(mm_sh(j)*z(n))/cos(mm_sh(j)*z(n))
              enddo
            enddo
          endif
!
        case('parker_wind')
!
!  Parker wind
!
          if (.not.lspherical_coords) call fatal_error("init_uu", &
              "parker_wind only meaningful for spherical coordinates")
!
!  initial iteration step
!
          where (x(l1:l2) < .5) 
            ur=2.*x(l1:l2)
          elsewhere
            ur=2.
          endwhere
          phi0=-1.5+alog(4.)
!
!  iterate
!
          do iter=1,niter
            where (x(l1:l2) < .5) 
              ur=exp(.5*ur**2-2.*alog(x(l1:l2))-1./x(l1:l2)-phi0)
            elsewhere
              ur=sqrt(2.*(alog(ur*x(l1:l2)**2)+1./x(l1:l2)+phi0))
            endwhere
          enddo
          lnrhor=-alog(4.*ur*x(l1:l2)**2)
!
          do n=n1,n2
            do m=m1,m2
              f(l1:l2,m,n,iux)=ur
              f(l1:l2,m,n,ilnrho)=lnrhor
            enddo
          enddo
!
        case default
          !
          !  Catch unknown values
          !
          call fatal_error("init_uu", &
              "No such value for inituu: "//trim(inituu(j)))
!
        endselect
!
!  End loop over initial conditions
!
      enddo
!
!  Possibility of Lorentz limiter: u -> u/sqrt(1+u^2)
!
      if (llorentz_limiter) then
        do n=1,mz
        do m=1,my
          ss=f(:,m,n,iux:iuz)
          call dot2_mx(ss,ss2)
          do j=1,3
            f(:,m,n,j)=f(:,m,n,j)/sqrt(1.+ss2)
          enddo
        enddo
        enddo
      endif
!
!  Interface for user's own initial condition
!
      if (linitial_condition) call initial_condition_uu(f)
!
!  This allows an extra random velocity perturbation on
!  top of the initialization so far.
!
      if (urand /= 0) then
        if (lroot) print*, 'init_uu: Adding random uu fluctuations.'
        if (urand > 0) then
          do i=iux,iuz
            do n=1,mz; do m=1,my
              call random_number_wrapper(tmpmx)
              f(:,m,n,i) = f(:,m,n,i) + urand*(tmpmx-0.5)
            enddo; enddo
          enddo
        else
          if (lroot) print*, 'init_uu: Multiplicative fluctuations.'
          do i=iux,iuz
            do n=1,mz; do m=1,my
              call random_number_wrapper(tmpmx)
              f(:,m,n,i) = f(:,m,n,i) * urand*(tmpmx-0.5)
            enddo; enddo
          enddo
        endif
      endif
!
! mgellert, add random fluctuation only inside domain, not on boundary
!           (to be able to use the 'freeze' option for BCs)
!
      if (urandi /= 0) then
        if (urandi > 0) then
          if (lroot) print*, 'init_uu: Adding random uu fluctuations (not on boundary), urandi=',urandi
          do i=iux,iuz
            do n=n1+1,n2-1; do m=m1,m2; do l=l1+1,l2-1
              call random_number_wrapper(tmp0)
              f(l,m,n,i) = f(l,m,n,i) + urandi*(tmp0-0.5)
            enddo; enddo; enddo
          enddo
        else
          if (lroot) print*, 'init_uu: Multiplicative fluctuations (not on boundary), urandi=',urandi
          do i=iux,iuz
            do n=n1+1,n2-1; do m=m1,m2; do l=l1+1,l2-1
              call random_number_wrapper(tmp0)
              f(l,m,n,i) = f(l,m,n,i) * urandi*(tmp0-0.5)
            enddo; enddo; enddo
          enddo
        endif
      endif
!
!  Initialize auxiliaries to zero.
!
      if (lconservative) then
        f(:,:,:,iTij:iTij+5)=0.
        if (llorentz_as_aux) then
          f(:,:,:,ilorentz)=0.
        endif
      endif
!
    endsubroutine init_uu
!***********************************************************************
    subroutine pencil_criteria_hydro
!
!  All pencils that the Hydro module depends on are specified here.
!
!  20-nov-04/anders: coded
!
      lpenc_requested(i_uu)=.true.
!
      if (lparticles_lyapunov .or. lparticles_caustics .or. lparticles_tetrad) & 
        lpenc_requested(i_uij) = .true.
      if (ladvection_velocity) then
        if (lweno_transport) then
          lpenc_requested(i_uu)=.true.
          lpenc_requested(i_rho1)=.true.
          lpenc_requested(i_transprho)=.true.
          lpenc_requested(i_transpurho)=.true.
        else
          lpenc_requested(i_ugu)=.true.
        endif
      endif
      if (lprecession) lpenc_requested(i_rr)=.true.
      if (ldt.or.(ekman_friction/=0)) lpenc_requested(i_uu)=.true.
      if (Omega/=0.0) lpenc_requested(i_uu)=.true.
      if (idiag_uzcx10m/=0.0.or.idiag_uzsx10m/=0.0) lpenc_requested(i_uu)=.true.
!
!  Damping terms for lcylinder_in_a_box
!
      if (tdamp/=0.or.dampuext/=0.or.dampuint/=0) then
        if (lOmega_int.or.rdampext/=impossible.or.rdampint/=impossible) &
            lpenc_requested(i_r_mn)=.true.
        if (lcylinder_in_a_box) lpenc_requested(i_rcyl_mn)=.true.
      endif
!
!  1/rho needed for correcting the damping term
!
      if (tau_damp_ruxm/=0..or.tau_damp_ruym/=0..or.tau_damp_ruzm/=0.) &
        lpenc_requested(i_rho1)=.true.
!
      if (lisotropic_advection) lpenc_requested(i_u2)=.true.
!
!  The following only play a role if lsphere_in_a_box
!  and there is a buoyancy term. (If only hydro, there is no buoyancy.)
!
      if (lboussinesq.and.ltemperature.and.lsphere_in_a_box) then
        lpenc_requested(i_evr)=.true.
        lpenc_requested(i_r_mn)=.true.
      endif
!
      if (lfargo_advection) then
        lpenc_requested(i_uu_advec)=.true.
        lpenc_requested(i_uuadvec_guu)=.true.
      endif
!
!  Request unit vectors for transformation of velocity from Cartesian
!  to spherical coordinates.
!
      if (luu_sph_as_aux.and.lsphere_in_a_box) then
        lpenc_requested(i_evr)=.true.
        lpenc_requested(i_evth)=.true.
        lpenc_requested(i_phix)=.true.
        lpenc_requested(i_phiy)=.true.
      endif
!
!  video pencils
!
      if (lwrite_slices) then
        if (ivid_oo  /=0) lpenc_video(i_oo)=.true.
        if (ivid_ou  /=0) lpenc_video(i_ou)=.true.
        if (ivid_o2  /=0) lpenc_video(i_o2)=.true.
        if (ivid_divu/=0) lpenc_video(i_divu)=.true.
        if (ivid_u2  /=0) lpenc_video(i_u2)=.true.
        if (ivid_Ma2 /=0) lpenc_video(i_Ma2)=.true.
        if (ivid_uu_sph/=0) lpenc_video(i_uu_sph)=.true.
      endif
!
!  diagnostic pencils
!
      lpenc_diagnos(i_uu)=.true.
      if (idiag_oumphi/=0 .or. idiag_oumxy/=0 .or. &
          idiag_oumxz/=0) lpenc_diagnos2d(i_ou)=.true.
      if (idiag_ozmphi/=0) lpenc_diagnos2d(i_oo)=.true.
      if (idiag_u2mphi/=0) lpenc_diagnos2d(i_u2)=.true.
      if (idiag_ox2m/=0 .or. idiag_oy2m/=0 .or. idiag_oz2m/=0 .or. &
          idiag_ox3m/=0 .or. idiag_oy3m/=0 .or. idiag_oz3m/=0 .or. &
          idiag_ox4m/=0 .or. idiag_oy4m/=0 .or. idiag_oz4m/=0 .or. &
          idiag_oxm /=0 .or. idiag_oym /=0 .or. idiag_ozm /=0 .or. &
          idiag_oxoym/=0 .or. idiag_oxozm/=0 .or. idiag_oyozm/=0 .or. &
          idiag_oxuzxm/=0 .or. idiag_oyuzym/=0 .or. &
          idiag_pvzm /=0 .or. idiag_quxom/=0) &
          lpenc_diagnos(i_oo)=.true.
      if (idiag_orms/=0 .or. idiag_omax/=0 .or. idiag_o2m/=0 .or. idiag_o2u2m/=0 .or. idiag_o2sphm/=0 .or. &
          idiag_ormsh/=0 .or. idiag_o2mz/=0 ) lpenc_diagnos(i_o2)=.true.
      if (idiag_q2m/=0 .or. idiag_qrms/=0 .or. idiag_qmax/=0 .or. &
          idiag_qfm/=0 .or. idiag_qom/=0 .or. idiag_quxom/=0) &
          lpenc_diagnos(i_curlo)=.true.
      if (idiag_divu2m/=0 .or. idiag_divu2mz/=0 .or. idiag_divru2mz/=0 .or. &
          idiag_divum/=0 .or. idiag_rdivum/=0) lpenc_diagnos(i_divu)=.true.
      if (idiag_rdivum/=0 .or. idiag_fkinzm/=0 .or. idiag_ruzupmz/=0 .or. idiag_ruzdownmz/=0) &
          lpenc_diagnos(i_rho)=.true.
      if (idiag_ruxupmxy/=0 .or. idiag_ruxdownmxy/=0) &
          lpenc_diagnos2d(i_rho)=.true.
      if (idiag_gdivu2m/=0) lpenc_diagnos(i_graddivu)=.true.
      if (idiag_oum/=0 .or. idiag_ourms/=0 .or. idiag_oumx/=0 .or. idiag_oumy/=0 .or. &
           idiag_oumz/=0 .or. idiag_oumh/=0 .or. idiag_ou_int/=0 ) lpenc_diagnos(i_ou)=.true.
      if (idiag_oxum/=0) lpenc_diagnos(i_oxu)=.true.
      if (idiag_oxurms/=0) lpenc_diagnos(i_oxu2)=.true.
      if (idiag_divrhourms/=0.or.idiag_divrhoumax/=0) then
        lpenc_diagnos(i_ugrho)=.true.
        lpenc_diagnos(i_divu)=.true.
        lpenc_diagnos(i_rho)=.true.
      endif
      if (idiag_Marms/=0 .or. idiag_Mamax/=0) lpenc_diagnos(i_Ma2)=.true.
      if (idiag_u3u21m/=0 .or. idiag_u3u21mz/=0) lpenc_diagnos(i_u3u21)=.true.
      if (idiag_u1u32m/=0 .or. idiag_u1u32mz/=0) lpenc_diagnos(i_u1u32)=.true.
      if (idiag_u2u13m/=0 .or. idiag_u2u13mz/=0) lpenc_diagnos(i_u2u13)=.true.
      if (idiag_u2u31m/=0 .or. idiag_u2u31mz/=0) lpenc_diagnos(i_u2u31)=.true.
      if (idiag_u3u12m/=0 .or. idiag_u3u12mz/=0) lpenc_diagnos(i_u3u12)=.true.
      if (idiag_u1u23m/=0 .or. idiag_u1u23mz/=0) lpenc_diagnos(i_u1u23)=.true.
      if (idiag_acczmz/=0 .or. idiag_acczupmz/=0 .or. idiag_acczdownmz/=0 .or. &
          idiag_accpowzmz/=0 .or. idiag_accpowzupmz/=0 .or. idiag_accpowzdownmz/=0 .or. &
          idiag_totalforcezmz/=0 .or. idiag_totalforcezupmz/=0 .or. &
          idiag_totalforcezdownmz/=0) then
          lpenc_diagnos(i_fpres)=.true.; lpenc_diagnos(i_fvisc)=.true.
          if (lgrav) lpenc_diagnos(i_gg)=.true.
      endif
      if (idiag_urms/=0 .or. idiag_durms/=0 .or. &
          idiag_umax/=0 .or. idiag_rumax/=0 .or. &
          idiag_fkinzm/=0 .or. idiag_u2m/=0 .or. idiag_um2/=0 .or. idiag_u2mz/=0 .or. &
          idiag_urmsh/=0 .or. idiag_urmsx/=0 .or. idiag_urmsz/=0 .or. idiag_u2sphm/=0) &
          lpenc_diagnos(i_u2)=.true.
      if (idiag_u2sphm/=0 .or. idiag_o2sphm/=0) lpenc_diagnos(i_r_mn)=.true.
      if (idiag_duxdzma/=0 .or. idiag_duydzma/=0 .or. lgradu_as_aux) lpenc_diagnos(i_uij)=.true.
      if (idiag_fmasszmz/=0 .or. idiag_ruxuym/=0 .or. &
          idiag_ruxm/=0 .or. idiag_ruym/=0 .or. idiag_ruzm/=0 .or. &
          idiag_ruxuzm/=0 .or. idiag_ruyuzm/=0 .or. idiag_pvzm/=0 .or. &
          idiag_ruxtot/=0) lpenc_diagnos(i_rho)=.true.
      if (idiag_ruxmz/=0 .or. idiag_ruymz/=0 .or. idiag_ruzmz/=0 .or. &
          idiag_rux2mz/=0 .or. idiag_ruy2mz/=0 .or. idiag_ruz2mz/=0 .or. &
          idiag_ruxmx/=0 .or. idiag_ruymx/=0 .or. idiag_ruzmx/=0 .or. &
          idiag_ruxuymz/=0 .or. idiag_ruxuzmz/=0 .or. idiag_ruyuzmz/=0 .or. &
          idiag_ruxuy2mz/=0 .or. idiag_ruxuz2mz/=0 .or. idiag_ruyuz2mz/=0 .or. idiag_uduum/=0) &
          lpenc_diagnos(i_rho)=.true.
      if (idiag_rux2mx /= 0 .or. idiag_ruy2mx /= 0 .or. idiag_ruz2mx /= 0 .or. &
          idiag_ruxuymx /= 0 .or. idiag_ruxuzmx /= 0 .or. idiag_ruyuzmx /= 0 .or. &
          idiag_rurmphi/=0 .or. idiag_rupmphi/=0 .or. idiag_ruzmphi/=0 .or. &
          idiag_rurupmphi/=0 .or. idiag_ruruzmphi/=0 .or. idiag_rursphmphi/=0 .or. &
          idiag_ruthmphi/=0) lpenc_diagnos(i_rho) = .true.
      if (idiag_ormr/=0 .or. idiag_opmr/=0 .or. idiag_ozmr/=0) &
          lpenc_diagnos(i_oo)=.true.
      if (idiag_oxmxy/=0 .or. idiag_oymxy/=0 .or. idiag_ozmxy/=0 .or. &
          idiag_oxmz/=0 .or. idiag_oymz/=0 .or. idiag_ozmz/=0 .or. &
          idiag_ox2mz/=0 .or. idiag_oy2mz/=0 .or. idiag_oz2mz/=0 .or. &
          idiag_pvzmxy/=0) &
          lpenc_diagnos2d(i_oo)=.true.
      if (idiag_pvzmxy/=0) lpenc_diagnos2d(i_rho)=.true.
      if (idiag_totangmom/=0 ) lpenc_diagnos(i_rcyl_mn)=.true.
      if (idiag_urmr/=0 .or.  idiag_ormr/=0 .or. idiag_urmphi/=0 .or. idiag_rurmphi/=0 .or. &
          idiag_ur2mphi/=0 .or. idiag_urupmphi/=0 .or. idiag_uruzmphi/=0 .or. &
          idiag_rurupmphi/=0 .or. idiag_ruruzmphi/=0) then
        lpenc_diagnos(i_pomx)=.true.
        lpenc_diagnos(i_pomy)=.true.
      endif
      if (idiag_ursphmphi/=0 .or. idiag_rursphmphi/=0 .or. idiag_fkinrsphmphi/=0) &
        lpenc_diagnos2d(i_evr)=.true.
      if (idiag_uthmphi/=0 .or. idiag_ruthmphi/=0) lpenc_diagnos2d(i_evth)=.true.
      if (idiag_upmr/=0 .or. idiag_opmr/=0 .or. idiag_upmphi/=0 .or. idiag_rupmphi/=0 .or. &
          idiag_up2mphi/=0 .or. idiag_urupmphi/=0 .or. idiag_upuzmphi/=0 .or. &
          idiag_rurupmphi/=0 .or. idiag_rupuzmphi/=0) then
        lpenc_diagnos(i_phix)=.true.
        lpenc_diagnos(i_phiy)=.true.
      endif
      if (idiag_EEK/=0 .or. idiag_ekin/=0 .or. idiag_ekintot/=0 .or. idiag_fkinzmz/=0 .or. &
           idiag_fkinzupmz/=0 .or. idiag_fkinzdownmz/=0 .or. &
           idiag_ekinmx /= 0 .or. idiag_ekinmz/=0 .or. idiag_fkinxmx/=0) then
        lpenc_diagnos(i_ekin)=.true.
      endif
      if (idiag_fkinxmxy/=0 .or. idiag_fkinymxy/=0 .or. &
          idiag_fkinxupmxy/=0 .or. idiag_fkinxdownmxy/=0 .or. idiag_fkinrsphmphi/=0) then
        lpenc_diagnos2d(i_uu)=.true.
        lpenc_diagnos2d(i_ekin)=.true.
      endif
      if (idiag_uxmxy/=0 .or. idiag_uymxy/=0 .or. idiag_uzmxy/=0 .or. &
          idiag_ux2mxy/=0 .or. idiag_uy2mxy/=0 .or. idiag_uz2mxy/=0 .or. &
          idiag_ruxmxy/=0 .or. idiag_ruymxy/=0 .or. idiag_ruzmxy/=0 .or.  &
          idiag_uxuymxy/=0 .or. idiag_uxuzmxy/=0 .or. idiag_uyuzmxy/=0 .or. &
          idiag_ruxuymxy/=0 .or. idiag_ruxuzmxy/=0 .or. &
          idiag_uxupmxy/=0 .or. idiag_uxdownmxy/=0 .or. &
          idiag_ux2upmxy/=0 .or. idiag_ux2downmxy/=0 .or. &
          idiag_ruxupmxy/=0 .or. idiag_ruxdownmxy/=0 .or. &
          idiag_ruyuzmxy/=0 .or. idiag_ffdownmxy/=0) then
        lpenc_diagnos2d(i_uu)=.true.
      endif
      if (idiag_ruxmxy/=0 .or. idiag_ruymxy/=0 .or. idiag_ruzmxy/=0 .or. &
          idiag_ruxuymxy/=0 .or. idiag_ruxuzmxy/=0 .or. idiag_ruyuzmxy/=0) &
        lpenc_diagnos2d(i_rho)=.true.
      if (idiag_uguxm/=0 .or. idiag_uguym/=0 .or. idiag_uguzm/=0) &
          lpenc_diagnos(i_ugu)=.true.
      if (idiag_uguxmxy/=0 .or. idiag_uguymxy/=0 .or. idiag_uguzmxy/=0) &
          lpenc_diagnos2d(i_ugu)=.true.
!
      if (idiag_ugu2m/=0 .or. idiag_ugurmsx/=0) lpenc_diagnos(i_ugu2)=.true.
      if (idiag_uguxmx/=0 .or. idiag_uguymx/=0 .or. idiag_uguzmx/=0 .or. &
          idiag_uguxmy/=0 .or. idiag_uguymy/=0 .or. idiag_uguzmy/=0 .or. &
          idiag_uguxmz/=0 .or. idiag_uguymz/=0 .or. idiag_uguzmz/=0) &
          lpenc_diagnos(i_ugu)=.true.
!
      if (idiag_Remz/=0) then
        lpenc_diagnos(i_ugu2)=.true.
        lpenc_diagnos(i_diffus_total)=.true.
      endif
!
      if (idiag_oguxmz/=0 .or. idiag_oguymz/=0 .or. idiag_oguzmz/=0 .or. &
          idiag_ogux2mz/=0 .or. idiag_oguy2mz/=0 .or. idiag_oguz2mz/=0) &
          lpenc_diagnos(i_ogu)=.true.
!
      if (idiag_oxdivumz/=0  .or. idiag_oydivumz/=0  .or. idiag_ozdivumz/=0 .or. &
          idiag_oxdivu2mz/=0 .or. idiag_oydivu2mz/=0 .or. idiag_ozdivu2mz/=0) then
        lpenc_diagnos(i_oo)=.true.
        lpenc_diagnos(i_divu)=.true.
      endif
!
      if (idiag_udpxxm/=0 .or. idiag_udpyym/=0 .or. idiag_udpzzm/=0 .or. &
          idiag_udpxym/=0 .or. idiag_udpyzm/=0 .or. idiag_udpxzm/=0) then
        lpenc_diagnos(i_uu)=.true.
        lpenc_diagnos(i_fpres)=.true.
      endif
!
! check whether right variables are set for half-box calculations.
!
      if (idiag_urmsn/=0 .or. idiag_ormsn/=0 .or. idiag_oumn/=0) then
        if ((.not.lequatory).and.(.not.lequatorz)) then
          call fatal_error("pencil_criteria_hydro","You have to set either of"// &
              "lequatory or lequatorz to true to calculate averages over half the box")
        else
          if (lequatory) write(*,*) 'pencil-criteria_hydro: box divided along y dirn'
          if (lequatorz) write(*,*) 'pencil-criteria_hydro: box divided along z dirn'
        endif
      else
      endif
!
    endsubroutine pencil_criteria_hydro
!***********************************************************************
    subroutine pencil_interdep_hydro(lpencil_in)
!
!  Interdependency among pencils from the Hydro module is specified here.
!
!  20-nov-04/anders: coded
!
      logical, dimension (npencils) :: lpencil_in
!
      if (lpencil_in(i_u2)) lpencil_in(i_uu)=.true.
      if (lpencil_in(i_divu)) lpencil_in(i_uij)=.true.
      if (lpencil_in(i_sij)) then
        lpencil_in(i_uij)=.true.
        lpencil_in(i_divu)=.true.
      endif
      !if (.not.lcartesian_coords.or.lalways_use_gij_etc.or.lpencil(i_oij)) then
      if (.not.lcartesian_coords.or.lalways_use_gij_etc) then
        if (lpencil_in(i_del2u)) then
          lpencil_in(i_graddivu)=.true.
          lpencil_in(i_curlo)=.true.
        endif
      endif
      if (lpencil_in(i_oo) .and. ioo == 0) lpencil_in(i_uij) = .true.
      if (lpencil_in(i_o2)) lpencil_in(i_oo)=.true.
      if (lpencil_in(i_oxu2)) lpencil_in(i_oxu)=.true.
      if (lpencil_in(i_ou) .or. lpencil_in(i_oxu)) then
        lpencil_in(i_uu)=.true.
        lpencil_in(i_oo)=.true.
      endif
      if (lpencil_in(i_ugu)) then
        lpencil_in(i_uu)=.true.
        lpencil_in(i_uij)=.true.
      endif
      if (lpencil_in(i_ogu)) then
        lpencil_in(i_uu)=.true.
        lpencil_in(i_oo)=.true.
        lpencil_in(i_uij)=.true.
      endif
      if (lpencil_in(i_u3u21) .or. &
          lpencil_in(i_u1u32) .or. &
          lpencil_in(i_u2u13) .or. &
          lpencil_in(i_u2u31) .or. &
          lpencil_in(i_u3u12) .or. &
          lpencil_in(i_u1u23)) then
        lpencil_in(i_uu)=.true.
        lpencil_in(i_uij)=.true.
      endif
!
!  other general interdependencies
!
      if (lpencil_in(i_sij2)) lpencil_in(i_sij)=.true.
!     if (lpencil_in(i_del2u)) lpencil_in(i_curlo)=.true.
      if (lpencil_in(i_curlo)) lpencil_in(i_oij)=.true.
      if (lpencil_in(i_oij).and.(.not.lcartesian_coords)) &
          lpencil_in(i_oo)=.true.
!
      if (lpencil_in(i_uu_advec)) lpencil_in(i_uu)=.true.
      if (lpencil_in(i_uuadvec_guu)) then
        lpencil_in(i_uu_advec)=.true.
        lpencil_in(i_uij)=.true.
      endif
!
    endsubroutine pencil_interdep_hydro
!***********************************************************************
    subroutine calc_pencils_hydro_pencpar(f,p,lpenc_loc)
!
! Calls linearized or nonlinear hydro routine depending on whether llinearized_hydro is
! selected or not (the default is nonlinear).
!
! 24-jun-13/dhruba: coded
! 20-sep-13/MR    : added optional list of indices in lpencil, penc_inds,
!                   for which pencils are calculated, default: all
! 21-sep-13/MR    : returned to pencil mask as parameter lpenc_loc
!
      real, dimension (mx,my,mz,mfarray),intent(INOUT):: f
      type (pencil_case),                intent(INOUT):: p
      logical, dimension(:),             intent(IN) :: lpenc_loc
!
      if (llinearized_hydro) then
        call calc_pencils_hydro_linearized(f,p,lpenc_loc)
      else
        call calc_pencils_hydro_nonlinear(f,p,lpenc_loc)
      endif
!
      endsubroutine calc_pencils_hydro_pencpar
!***********************************************************************
    subroutine calc_pencils_hydro_std(f,p)
!
! Envelope adjusting calc_pencils_hydro_pencpar to the standard use with
! lpenc_loc=lpencil
!
! 21-sep-13/MR    : coded
!
      real, dimension (mx,my,mz,mfarray),intent(INOUT):: f
      type (pencil_case),                intent(INOUT):: p
!
      call calc_pencils_hydro_pencpar(f,p,lpencil)
!
      endsubroutine calc_pencils_hydro_std
!***********************************************************************
    subroutine calc_pencils_hydro_nonlinear(f,p,lpenc_loc)
!
!  Calculate Hydro pencils.
!  Most basic pencils should come first, as others may depend on them.
!
!  08-nov-04/tony: coded
!  26-mar-07/axel: started using the gij_etc routine
!  24-jun-13/dhruba: the earlier calc_pencils_hydro routine is copied here.
!  20-sep-13/MR    : added optional list of indices in lpencil, penc_inds,
!                    for which pencils are calculated, default: all
!  21-sep-13/MR    : instead pencil mask as parameter lpenc_loc
!  19-feb-15/MR    : adapted weno transport to use of reference state
!
      use Deriv, only: der6, der5i1j
      use Sub, only: multsv_mn, del2v_etc, gij_etc, u_dot_grad, del6v, &
        dot2_mn, gij, div_mn, traceless_strain, curl_mn, multm2_sym_mn, &
        dot_mn, cross, del4v, del4graddiv, d2fi_dxj, del2fi_dxjk, h_dot_grad
      use WENO_transport, only: weno_transp
      use EquationOfState, only: cs20
!
      real, dimension (mx,my,mz,mfarray) :: f
      type (pencil_case) :: p
      logical, dimension(npencils) :: lpenc_loc
!
      real, dimension (nx) :: tmp, c_sld_im12, c_sld_ip12
      real, dimension (nx,3) :: tmp3
      real :: cs201
      integer :: i, j, ju, jj, kk, jk
!
      intent(in)   :: lpenc_loc
      intent(inout):: f,p
!
!  uu is directly p%uu=f(l1:l2,m,n,iux:iuz), but with lconservative
!  it is the momentum, or T^{0i} in the relativistic case.
!
      if (lpenc_loc(i_uu)) then
        p%uu=f(l1:l2,m,n,iux:iuz)  !(in the conservative case, this becomes the velocity later!)
!
!  In the relativistic case, which must also be conservative, cs201=4/3, if cs2=1/3.
!  At this point, the Lorentz factor gamma^2 is already available.
!  We solve here Eq. (39) of the notes.
!
        if (lconservative) then
          if (lrelativistic) then
            cs201=cs20+1.
            if (lmagnetic) then
              tmp=1./((f(l1:l2,m,n,irho)-.5*B_ext2)/(1.-.25/f(l1:l2,m,n,ilorentz))+B_ext2)
            else
              tmp=1./(f(l1:l2,m,n,irho)/(1.-.25/f(l1:l2,m,n,ilorentz)))
            endif
      !     call multsv_mn(tmp,p%uu,p%uu)
!
!  In the non-relativisitic (but conservative) case, f(:,:,:,iuu) is the momentum,
!  so to get the velocity, we have to divide by it.
!
          else
            p%rho1=1./f(l1:l2,m,n,irho)
            call multsv_mn(p%rho1,p%uu,p%uu)
          endif
        endif
      endif
! u2
      if (lpenc_loc(i_u2)) call dot2_mn(p%uu,p%u2)
! uij
      if (lpenc_loc(i_uij)) then
        call gij(f,iuu,p%uij,1)
!
!  if gradu is to be stored as auxiliary then we store it now
!
        if (lgradu_as_aux .or. lparticles_lyapunov .or. lparticles_caustics .or. lparticles_tetrad) then
          jk=0
          do jj=1,3; do kk=1,3
            f(l1:l2,m,n,iguij+jk) = p%uij(:,jj,kk)
            jk=jk+1
          enddo;enddo
        endif
      endif
!      if (.not.lpenc_loc_check_at_work) then
!        write(*,*) 'uurad,rad',p%uij(1:6,1,1)
!      endif
!
! divS, needed for relativistic calculations
!
!     if (lpenc_loc(i_divss)) then
!       call div(f,iux,p%divss)
!print*,'AXEL: divss now calculated: p%divss(1:5)=',p%divss(1:5)
!     endif
! divu
      if (lpenc_loc(i_divu)) then
        call div_mn(p%uij,p%divu,p%uu)
      endif
! sij
      if (lpenc_loc(i_sij)) call traceless_strain(p%uij,p%divu,p%sij,p%uu,lshear_rateofstrain)
! sij2
      if (lpenc_loc(i_sij2)) call multm2_sym_mn(p%sij,p%sij2)
! uij5
      if (lpenc_loc(i_uij5)) call gij(f,iuu,p%uij5,5)
! oo (=curlu)
      if (lpenc_loc(i_oo)) then
        if (ioo /= 0) then
          p%oo = f(l1:l2,m,n,iox:ioz)
        else
          call curl_mn(p%uij,p%oo,p%uu)
        endif
      endif
! o2 and oxu2
      if (lpenc_loc(i_o2)) call dot2_mn(p%oo,p%o2)
! ou and oxu
      if (lpenc_loc(i_ou)) call dot_mn(p%oo,p%uu,p%ou)
      if (lpenc_loc(i_oxu)) call cross(p%oo,p%uu,p%oxu)
      if (lpenc_loc(i_oxu2)) call dot2_mn(p%oxu,p%oxu2)
! Useful to debug forcing - Dhruba
      if (loutest.and.lpenc_loc(i_ou))then
!      write(*,*) lpenc_loc(i_ou)
        outest = minval(p%ou)
        if (outest<(-1.0d-8))then
          write(*,*) m,n,outest,maxval(p%ou),lpenc_loc(i_ou)
          write(*,*)'WARNING : hydro:ou has different sign than relhel'
        endif
      endif
!
!  ugu
!
      if (lpenc_loc(i_ugu)) then
        if (headtt.and.lupw_uu) print *,'calc_pencils_hydro: upwinding advection term'
        call u_dot_grad(f,iuu,p%uij      ,p%uu,p%ugu,UPWIND=lupw_uu)
!
!      if (.not.lpenc_loc_check_at_work) then
!        write(*,*) 'ugu',p%ugu(1:6,1)
!      endif
!        if (.not.lpenc_loc_check_at_work) then
!          write(*,*) 'DM',x(l1:l2)
!          write(*,*) 'DM',p%uu(:,1)
!          write(*,*) 'DM',p%uij(:,1,1)
!        endif
!
!  If lffree switched is used, we need to turn off the u.gradu term
!  to ensure momentum conservation.
!
        if (ldensity) then
          if (lffree) then
            tmp=profx_ffree*profy_ffree(m)*profz_ffree(n)
            do j=1,3
              p%ugu(:,j)=p%ugu(:,j)*tmp
            enddo
          endif
        endif
      endif
! ugu2
      if (lpenc_loc(i_ugu2)) call dot2_mn(p%ugu,p%ugu2)
! ogu ... ogu2
      if (lpenc_loc(i_ogu)) call u_dot_grad(f,iuu,p%uij,p%oo,p%ogu,UPWIND=lupw_uu)
! u3u21, u1u32, u2u13, u2u31, u3u12, u1u23
      if (lpenc_loc(i_u3u21)) p%u3u21=p%uu(:,3)*p%uij(:,2,1)
      if (lpenc_loc(i_u1u32)) p%u1u32=p%uu(:,1)*p%uij(:,3,2)
      if (lpenc_loc(i_u2u13)) p%u2u13=p%uu(:,2)*p%uij(:,1,3)
      if (lpenc_loc(i_u2u31)) p%u2u31=p%uu(:,2)*p%uij(:,3,1)
      if (lpenc_loc(i_u3u12)) p%u3u12=p%uu(:,3)*p%uij(:,1,2)
      if (lpenc_loc(i_u1u23)) p%u1u23=p%uu(:,1)*p%uij(:,2,3)
! del4u, del6u, del4graddivu, and del6u_strict
      if (lpenc_loc(i_del4u)) call del4v(f,iuu,p%del4u)
      if (lpenc_loc(i_del6u)) call del6v(f,iuu,p%del6u)
      if (lpenc_loc(i_del6u_strict)) call del6v(f,iuu,p%del6u_strict,LSTRICT=.true.)
      if (lpenc_loc(i_del4graddivu)) call del4graddiv(f,iuu,p%del4graddivu)
! del6u_bulk
      if (lpenc_loc(i_del6u_bulk)) then
        call der6(f,iux,p%del6u_bulk(:,1),1)
        call der6(f,iuy,p%del6u_bulk(:,2),2)
        call der6(f,iuz,p%del6u_bulk(:,3),3)
      endif
! der6u_res
      if (lpenc_loc(i_der6u_res)) then
        if (lcartesian_coords) call fatal_error("calc_pencils_hydro_nonlinear",&
                  "der6u_res: This pencil is not implemented for Cartesian coordinates")
        do j=1,3
          ju=j+iuu-1
          do i=1,3
            if (lcylindrical_coords.and.ju==iuy.and.i==1) then  
              call der6(i,f(:,m,n,iuy)-uu_average_cyl(:,n),p%der6u_res(:,i,j),IGNOREDX=.true.)                
            elseif (lspherical_coords.and.ju==iuz.and.i==1) then  
              call der6(i,f(:,m,n,iuz)-uu_average_sph(:,m),p%der6u_res(:,i,j),IGNOREDX=.true.)                
            else   
              call der6(f,ju,p%der6u_res(:,i,j),i,IGNOREDX=.true.)
            endif
          enddo
        enddo
      endif
!
! del2u, graddivu
!
      if (.not.lcartesian_coords.or.lalways_use_gij_etc) then
        if (lpenc_loc(i_graddivu)) then
          if (headtt.or.ldebug) print*,'calc_pencils_hydro: call gij_etc'
          call gij_etc(f,iuu,p%uu,p%uij,p%oij,GRADDIV=p%graddivu)
        endif
        if (lpenc_loc(i_del2u)) then
          call curl_mn(p%oij,p%curlo,p%oo)
          p%del2u=p%graddivu-p%curlo
        endif
      else
!
!  all 3 together
!
        if (lpenc_loc(i_del2u).and.lpenc_loc(i_graddivu).and.lpenc_loc(i_curlo)) then
          call del2v_etc(f,iuu,DEL2=p%del2u,GRADDIV=p%graddivu,CURLCURL=p%curlo)
!
!  all 3 possible pairs
!
        elseif (lpenc_loc(i_del2u).and.lpenc_loc(i_graddivu)) then
          call del2v_etc(f,iuu,DEL2=p%del2u,GRADDIV=p%graddivu)
        elseif (lpenc_loc(i_del2u).and.lpenc_loc(i_curlo)) then
          call del2v_etc(f,iuu,DEL2=p%del2u,CURLCURL=p%curlo)
        elseif (lpenc_loc(i_graddivu).and.lpenc_loc(i_curlo)) then
          call del2v_etc(f,iuu,GRADDIV=p%graddivu,CURLCURL=p%curlo)
!
!  all 3 individually
!
        elseif (lpenc_loc(i_del2u)) then
          call del2v_etc(f,iuu,DEL2=p%del2u)
        elseif (lpenc_loc(i_graddivu)) then
          call del2v_etc(f,iuu,GRADDIV=p%graddivu)
        elseif (lpenc_loc(i_curlo)) then
          call del2v_etc(f,iuu,CURLCURL=p%curlo)
        endif
      endif
!
!del2uj, d^u/dx^2 etc
!
      if (lpenc_loc(i_d2uidxj)) call d2fi_dxj(f,iuu,p%d2uidxj)
!
! deluidxjk
!
      if (lpenc_loc(i_uijk)) call del2fi_dxjk(f,iuu,p%uijk)
!
! grad5divu
!
      if (lpenc_loc(i_grad5divu)) then
        do i=1,3
          p%grad5divu(:,i) = 0.0
          do j=1,3
            ju=iuu+j-1
            call der5i1j(f,ju,tmp,i,j)
            p%grad5divu(:,i) = p%grad5divu(:,i) + tmp
          enddo
        enddo
      endif
! transpurho
      if (lpenc_loc(i_transpurho)) then
        if (lreference_state) then
          call weno_transp(f,m,n,iux,irho,iux,iuy,iuz,p%transpurho(:,1),dx_1,dy_1,dz_1, &
                           ref1=reference_state(:,iref_rho))
          call weno_transp(f,m,n,iuy,irho,iux,iuy,iuz,p%transpurho(:,2),dx_1,dy_1,dz_1, &
                           ref1=reference_state(:,iref_rho))
          call weno_transp(f,m,n,iuz,irho,iux,iuy,iuz,p%transpurho(:,3),dx_1,dy_1,dz_1, &
                           ref1=reference_state(:,iref_rho))
        else
          call weno_transp(f,m,n,iux,irho,iux,iuy,iuz,p%transpurho(:,1),dx_1,dy_1,dz_1)
          call weno_transp(f,m,n,iuy,irho,iux,iuy,iuz,p%transpurho(:,2),dx_1,dy_1,dz_1)
          call weno_transp(f,m,n,iuz,irho,iux,iuy,iuz,p%transpurho(:,3),dx_1,dy_1,dz_1)
        endif
      endif
!
      if (lpenc_loc(i_uu_advec)) then
!
! Advect by the original radial and vertical, but residual azimuthal (= relative) velocity
!
        p%uu_advec(:,1)=p%uu(:,1)
        if (lcylindrical_coords) then
          p%uu_advec(:,2)=p%uu(:,2)-uu_average_cyl(l1:l2,n)
          p%uu_advec(:,3)=p%uu(:,3)
        elseif (lspherical_coords) then
          p%uu_advec(:,2)=p%uu(:,2)
          p%uu_advec(:,3)=p%uu(:,3)-uu_average_sph(l1:l2,m)
        endif
!
        do j=1,3
          ! This is calling scalar h_dot_grad, that does not add
          ! the inertial terms. They will be added here.
          tmp3 = p%uij(:,j,:)
          call h_dot_grad(p%uu_advec,tmp3,p%uuadvec_guu(:,j))
        enddo
        if (lcylindrical_coords) then
          p%uuadvec_guu(:,1)=p%uuadvec_guu(:,1)-rcyl_mn1*p%uu(:,2)*p%uu(:,2)
          p%uuadvec_guu(:,2)=p%uuadvec_guu(:,2)+rcyl_mn1*p%uu(:,2)*p%uu(:,1)
        elseif (lspherical_coords) then
          p%uuadvec_guu(:,1)=p%uuadvec_guu(:,1)-r1_mn*(p%uu(:,2)*p%uu(:,2)+p%uu(:,3)*p%uu(:,3))
          p%uuadvec_guu(:,2)=p%uuadvec_guu(:,2)+r1_mn*(p%uu(:,2)*p%uu(:,1)-p%uu(:,3)*p%uu(:,3)*cotth(m))
          p%uuadvec_guu(:,3)=p%uuadvec_guu(:,3)+r1_mn*(p%uu(:,3)*p%uu(:,1)+p%uu(:,3)*p%uu(:,2)*cotth(m))
        endif
      endif
!
      if (lpenc_loc(i_uu_sph).and.luu_sph_as_aux) p%uu_sph=f(l1:l2,m,n,iuu_sphr:iuu_sphp)
!
    endsubroutine calc_pencils_hydro_nonlinear
!***********************************************************************
    subroutine calc_pencils_hydro_linearized(f,p,lpenc_loc)
!
!  Calculate linearized hydro pencils.
!  Most basic pencils should come first, as others may depend on them.
!
!  24-jun-13/dhruba: aped from calc_pencils_hydro from previous version
!  20-sep-13/MR    : added optional list of indices in lpencil, penc_inds,
!                    for which pencils are calculated, default: all
!  21-sep-13/MR    : instead pencil mask as parameter lpenc_loc
!
      use Deriv
      use Sub
      use WENO_transport
!
      real, dimension (mx,my,mz,mfarray) :: f
      type (pencil_case) :: p
      logical, dimension(npencils) :: lpenc_loc
!
      real, dimension (nx) :: tmp, tmp2
      real, dimension (nx,3) :: ugu0,u0gu
      integer :: i, j, ju
!
      intent(in) :: f, lpenc_loc
      intent(out) :: p
! uu
      if (lpenc_loc(i_uu)) p%uu=f(l1:l2,m,n,iux:iuz)
      if (lpenc_loc(i_uu0)) p%uu0=f(l1:l2,m,n,iu0x:iu0z)
! u2, should not be calculated
      if (lpenc_loc(i_u2)) call fatal_error('calc_pencils_hydro_linearized:','does not calculate u2 pencil')
! uij
      if (lpenc_loc(i_uij)) call gij(f,iuu,p%uij,1)
      if (lpenc_loc(i_u0ij)) call gij(f,iuu0,p%u0ij,1)
! divu
      if (lpenc_loc(i_divu)) call div_mn(p%uij,p%divu,p%uu)
      if (lpenc_loc(i_divu0)) call div_mn(p%u0ij,p%divu0,p%uu0)
! sij
      if (lpenc_loc(i_sij)) call traceless_strain(p%uij,p%divu,p%sij,p%uu,lshear_rateofstrain)
! sij2
      if (lpenc_loc(i_sij2)) call fatal_error('calc_pencils_hydro_linearized:','does not calculate sij2 pencil')
! uij5
      if (lpenc_loc(i_uij5)) call fatal_error('calc_pencils_hydro_linearized:','does not calculate uij5 pencil')
! oo (=curlu)
      if (lpenc_loc(i_oo)) then
        call curl_mn(p%uij,p%oo,p%uu)
      endif
! o2
      if (lpenc_loc(i_o2) .or. lpenc_loc(i_oxu2)) &
        call fatal_error('calc_pencils_hydro_linearized:','does not calculate o2 or oxu2 pencils')
! ou
      if (lpenc_loc(i_ou) .or. lpenc_loc(i_oxu)) &
        call fatal_error('calc_pencils_hydro_linearized:','does not calculate ou or oxu pencils')
! ugu
      if (lpenc_loc(i_ugu)) then
        if (headtt.and.lupw_uu) print *,'calc_pencils_hydro: upwinding advection term'
!        call u_dot_grad(f,iuu,p%uij,p%uu,p%ugu,UPWIND=lupw_uu)
        if (lconservative) then
          call fatal_error('calc_pencils_hydro_linearized:', &
              'does not calculate ugu pencil in lconservative case')
        else
          call u_dot_grad(f,iuu0,p%u0ij,p%uu,ugu0,UPWIND=lupw_uu)
          call u_dot_grad(f,iuu,p%uij,p%uu0,u0gu,UPWIND=lupw_uu)
        endif
        p%ugu = ugu0+u0gu
      endif
! ugu2
      if (lpenc_loc(i_ugu2)) call fatal_error('calc_pencils_hydro_linearized:','does not calculate ugu2 pencil')
! u3u21, u1u32, u2u13, u2u31, u3u12, u1u23
      if (lpenc_loc(i_u3u21).or.lpenc_loc(i_u1u32).or.lpenc_loc(i_u2u13)  &
        .or.lpenc_loc(i_u2u31).or.lpenc_loc(i_u3u12).or.lpenc_loc(i_u1u23) ) then
        call fatal_error('calc_pencils_hydro_linearized:','ujukl pencils not calculated')
      endif
! del4u, del6u, and del4graddivu
      if (lpenc_loc(i_del4u)) call del4v(f,iuu,p%del4u)
      if (lpenc_loc(i_del6u)) call del6v(f,iuu,p%del6u)
      if (lpenc_loc(i_del6u_strict)) call del6v(f,iuu,p%del6u_strict,LSTRICT=.true.)
      if (lpenc_loc(i_del4graddivu)) call del4graddiv(f,iuu,p%del4graddivu)
! del6u_bulk
      if (lpenc_loc(i_del6u_bulk)) then
        call der6(f,iux,tmp,1)
        p%del6u_bulk(:,1)=tmp
        call der6(f,iuy,tmp,2)
        p%del6u_bulk(:,2)=tmp
        call der6(f,iuz,tmp,3)
        p%del6u_bulk(:,3)=tmp
      endif
!
! del2u, graddivu
!
      if (.not.lcartesian_coords.or.lalways_use_gij_etc) then
        if (lpenc_loc(i_graddivu)) then
          if (headtt.or.ldebug) print*,'calc_pencils_hydro: call gij_etc'
          call gij_etc(f,iuu,p%uu,p%uij,p%oij,GRADDIV=p%graddivu)
        endif
        if (lpenc_loc(i_del2u)) then
          call curl_mn(p%oij,p%curlo,p%oo)
          p%del2u=p%graddivu-p%curlo
        endif
      else
!
!  all 3 together
!
        if (lpenc_loc(i_del2u).and.lpenc_loc(i_graddivu).and.lpenc_loc(i_curlo)) then
          call del2v_etc(f,iuu,DEL2=p%del2u,GRADDIV=p%graddivu,CURLCURL=p%curlo)
!
!  all 3 possible pairs
!
        elseif (lpenc_loc(i_del2u).and.lpenc_loc(i_graddivu)) then
          call del2v_etc(f,iuu,DEL2=p%del2u,GRADDIV=p%graddivu)
        elseif (lpenc_loc(i_del2u).and.lpenc_loc(i_curlo)) then
          call del2v_etc(f,iuu,DEL2=p%del2u,CURLCURL=p%curlo)
        elseif (lpenc_loc(i_graddivu).and.lpenc_loc(i_curlo)) then
          call del2v_etc(f,iuu,GRADDIV=p%graddivu,CURLCURL=p%curlo)
!
!  all 3 individually
!
        elseif (lpenc_loc(i_del2u)) then
          call del2v_etc(f,iuu,DEL2=p%del2u)
        elseif (lpenc_loc(i_graddivu)) then
          call del2v_etc(f,iuu,GRADDIV=p%graddivu)
        elseif (lpenc_loc(i_curlo)) then
          call del2v_etc(f,iuu,CURLCURL=p%curlo)
        endif
      endif
!
!del2uj, d^u/dx^2 etc
!
      if (lpenc_loc(i_d2uidxj)) &
        call d2fi_dxj(f,iuu,p%d2uidxj)
!
! deluidxjk
!
      if (lpenc_loc(i_uijk)) then
        call del2fi_dxjk(f,iuu,p%uijk)
      endif
!
! grad5divu
!
      if (lpenc_loc(i_grad5divu)) then
        do i=1,3
          tmp=0.0
          do j=1,3
            ju=iuu+j-1
            call der5i1j(f,ju,tmp2,i,j)
            tmp=tmp+tmp2
          enddo
          p%grad5divu(:,i)=tmp
        enddo
      endif
!
! transpurho
!
      if (lpenc_loc(i_transpurho)) &
        call fatal_error('calc_pencils_hydro_linearized:','no linearized weno transport ')
!
    endsubroutine calc_pencils_hydro_linearized
!***********************************************************************
    subroutine hydro_before_boundary(f)
!
!  Actions to take before boundary conditions are set.
!
!  15-dec-10/MR: adapted from density for homogeneity
!  19-oct-15/ccyang: add calculation of the vorticity field.
!
      use Sub, only: curl, dot2_mx
      use Mpicomm, only: mpiallreduce_sum
      use EquationOfState, only: cs20
!
      real, dimension (mx,my,mz,mfarray), intent(inout) :: f
!
      real, dimension(nx,3) :: pv
!
      real, dimension (mx,mz) :: fsum_tmp_cyl
      real, dimension (mx,my) :: fsum_tmp_sph
      real, dimension (mx) :: uphi
      real, dimension (mx,3) :: ss
      real, dimension (mx) :: ss2, hydro_energy, hydro_energy1, rat, rat0, vA2_pseudo
      real, dimension (mx) :: rho, rho1, press, rho_gam21, rho_gam20, lorentz_gamma2
      real :: nygrid1,nzgrid1
      real :: cs201, cs2011
      integer :: i, j, iter_relB
!
!  Remove mean momenta or mean flows if desired.
!  Useful to avoid unphysical winds, for example in shearing box simulations.
!
      if (lrmv) then
        if (lremove_mean_momenta) then
          call remove_mean_momenta(f,iux,ilnrho)
        else
          if (lremove_mean_flow) call remove_mean_flow(f,iux)
          !if (lremove_mean_flow) call remove_mean_value(f,iux,iuz)  !(could use this one)
          if (lremove_mean_angmom) call remove_mean_angmom(f,iuz)
        endif
      endif
!
!  Calculate the energy-momentum tensor.
!  In the non-relativisitic case, then Tij=rho*ui*uj+delij*p,
!  so with p=cs2*rho/3="press", we have Tij=Ti0*Tj0/rho+cs2*rho*delij/3.
!  To deal with truly nonrelativistic eos and conservative formulation,
!  we need to set rho_gam21=1/rho.
!  Note that the loop below is over all my and mz, not ny and nz,
!  so it includes the ghost zones.
!  Allowed for possibility to save relativistic Lorentz factor as aux.
!  The magnetic case can only be done iteratively, so we first compute
!  gamma for the nonmagnetic case.
!
      if (lconservative) then
        if (iTij==0) call fatal_error("hydro_before_boundary","must compute Tij for lconservative")
        cs201=cs20+1.
        cs2011=1./cs201
        do n=1,mz
        do m=1,my
          if (ldensity) then
            if (lmagnetic) then
              if (B_ext2/=0.) then
                hydro_energy=f(:,m,n,irho)-.5*B_ext2
              else
                hydro_energy=f(:,m,n,irho)
              endif
            else
              hydro_energy=f(:,m,n,irho)
            endif
            hydro_energy1=1./hydro_energy
          else
            hydro_energy=1.
            hydro_energy1=1.
          endif
!
!  Compute lorentz_gamma2.
!
          if (lrelativistic.or.llorentz_as_aux) then
            ss=f(:,m,n,iux:iuz)
            call dot2_mx(ss,ss2)
            rat0=ss2*hydro_energy1**2
            if (lmagnetic) then
              vA2_pseudo=B_ext2*cs2011*hydro_energy1
              rat=rat0/(1.+vA2_pseudo)**2
            else
              rat=rat0
            endif
            lorentz_gamma2=(.5-rat*cs20*cs2011+sqrt(.25-rat*cs20*cs2011**2))/(1.-rat)
!
!  In the magnetic case, we need to solve lorentz_gamma2 iteratively; first initialize it:
!  We also don't know rho yet (because it involves gamma^2), so we iterate for that, too.
!  In the magnetic case, the equation for lorentz_gamma2 is no longer quadratic, because
!  the term (1.+vA2_pseudo)**2 itself contains lorentz_gamma2.
!  The expression rho_gam2 means the same as (4/3)*rho*gamma^2, and rho_gam21=1/rho_gam2.
!  Now iterate (only works if relativistic)
!
            if (lmagnetic) then
              do iter_relB=1,niter_relB
                if (lrelativistic) then
                  rho1=(cs201*lorentz_gamma2-cs20)/hydro_energy
                  rho_gam20=cs2011*rho1/lorentz_gamma2
                  vA2_pseudo=B_ext2*rho_gam20
                  rat=rat0/(1.+vA2_pseudo)**2
                  lorentz_gamma2=(.5-rat*cs20*cs2011+sqrt(.25-rat*cs20*cs2011**2))/(1.-rat)
                else
                  if (llorentz_as_aux) lorentz_gamma2=1./(1.-rat)
                endif
              enddo
              rho=hydro_energy/(cs201*lorentz_gamma2-cs20)
              rho_gam21=1./(cs201*rho*lorentz_gamma2+B_ext2)
            else
              rho=hydro_energy/(cs201*lorentz_gamma2-cs20)
              rho_gam21=1./(cs201*rho*lorentz_gamma2)
            endif
!
!  If just conservative and non-relativistic, we just set rho and rho_gam21.
!
          else
            if (lrelativistic_eos) then
              rho=cs201*hydro_energy
            else
              rho=hydro_energy
            endif
            rho_gam21=1./(cs201*rho)
          endif
!
!  At the end, we put lorentz_gamma2 into the f array.
!
          if (ilorentz /= 0) f(:,m,n,ilorentz)=lorentz_gamma2
          press=rho*cs20
!
!  Now set the nonmagnetic stresses; begin with the diagonal components:
!  Tii=(Ti0)^2/rho or Tii=(Ti0)^2/(4./3.*rho*gamma^2)
!
          do j=0,2
            f(:,m,n,iTij+j)=rho_gam21*f(:,m,n,iuu+j)**2+press
          enddo
!
!  off-diagonal terms:
!  "Tij4" = T12
!  "Tij5" = T23
!  "Tij6" = T31
!
          f(:,m,n,iTij+3+0)=rho_gam21*f(:,m,n,iuu+0)*f(:,m,n,iuu+1)
          f(:,m,n,iTij+3+1)=rho_gam21*f(:,m,n,iuu+1)*f(:,m,n,iuu+2)
          f(:,m,n,iTij+3+2)=rho_gam21*f(:,m,n,iuu+2)*f(:,m,n,iuu+0)
!
!  The following hasn't been prepared yet.
!
    !     if (lbraginsky) then
    !       muparaB21=3.*muB*
    !       do j=0,2
    !         f(:,m,n,iTij+j)=muparaB21*f(:,m,n,ibb+j)**2
    !       enddo
    !       f(:,m,n,iTij+3+0)=muparaB21*f(:,m,n,ibb+0)*f(:,m,n,ibb+1)
    !       f(:,m,n,iTij+3+1)=muparaB21*f(:,m,n,ibb+1)*f(:,m,n,ibb+2)
    !       f(:,m,n,iTij+3+2)=muparaB21*f(:,m,n,ibb+2)*f(:,m,n,ibb+0)
    !     endif
        enddo
        enddo
!
!  Here is the endif of lconservative.
!
      endif
!
!  Calculate the vorticity field if required.
!
      if (ioo /= 0) then
        do n = n1, n2
          do m = m1, m2
            call curl(f, iux, pv)
            f(l1:l2,m,n,iox:ioz) = pv
          enddo 
        enddo
      endif
!
!    Slope limited diffusion: update characteristic speed
!    Not staggered yet, happpens later
!
     if (lslope_limit_diff .and. llast) then
!     if (lslope_limit_diff) then
       do m=1,my
       do n=1,mz
           f(:,m,n,isld_char)=w_sldchar_hyd* &
!            (f(:,m,n,iux)**2.+f(:,m,n,iuy)**2.+f(:,m,n,iuz)**2.)
            sqrt(f(:,m,n,iux)**2.+f(:,m,n,iuy)**2.+f(:,m,n,iuz)**2.)
       enddo
       enddo
     endif
!
!  For FARGO (orbital advection) algorithm.
!  Calculate the average velocity at the first sub-timestep.
!
     if ((lfargo_advection.and.lfirst).or.lcalc_uuavg) then
!
!  Pre-calculate the average large scale (= phi-averaged) speed of the flow
!
        if (lcylindrical_coords) then
          fsum_tmp_cyl=0.
          nygrid1=1./nygrid
          do n=1,mz
            do m=m1,m2
              uphi=f(:,m,n,iuy)
              fsum_tmp_cyl(:,n)=fsum_tmp_cyl(:,n)+uphi*nygrid1
            enddo
          enddo
!
! The sum has to be done processor-wise
! Sum over processors of same ipz, and different ipy
! --only relevant for 3D, but is here for generality
!
          call mpiallreduce_sum(fsum_tmp_cyl,uu_average_cyl,&
               (/mx,mz/),idir=2) !idir=2 is equal to old LSUMY=.true.
!
        elseif (lspherical_coords) then
          nzgrid1=1./nzgrid
          fsum_tmp_sph=0.
          do n=n1,n2
            do m=1,my
              uphi=f(:,m,n,iuz)
              fsum_tmp_sph(:,m)=fsum_tmp_sph(:,m)+uphi*nzgrid1
            enddo
          enddo
          call mpiallreduce_sum(fsum_tmp_sph,uu_average_sph,&
               (/mx,my/),idir=3) !idir=2 is equal to old LSUMY=.true.
!
        endif
     endif
!
    endsubroutine hydro_before_boundary
!***********************************************************************
    subroutine update_char_vel_hydro(f)
!
!   25-sep-15/MR+joern: coded
!   23-dec-15/joern: changed to staggered_max_vec
!   26-jan-16/MR: removed if clause around call as it is already in the caller
!
!   calculation of characteristic velocity
!   for slope limited diffusion
!
      use General, only: staggered_mean_vec,staggered_max_vec

      real, dimension (mx,my,mz,mfarray), intent(inout) :: f
!
!      call staggered_mean_vec(f,iux,iFF_char_c,w_sldchar_hyd)
      call staggered_max_vec(f,iux,iFF_char_c,w_sldchar_hyd)
!
    endsubroutine update_char_vel_hydro
!***********************************************************************
    subroutine duu_dt(f,df,p)
!
!  velocity evolution
!  calculate du/dt = - u.gradu - 2Omega x u + grav + Fvisc
!  pressure gradient force added in density and entropy modules.
!
!   7-jun-02/axel: incoporated from subroutine pde
!  10-jun-02/axel+mattias: added Coriolis force
!  23-jun-02/axel: glnrho and fvisc are now calculated in here
!  17-jun-03/ulf: ux2, uy2 and uz2 added as diagnostic quantities
!  27-jun-07/dhruba: differential rotation as subroutine call
!  12-apr-16/MR: changes for Yin-Yang: only yz slices at the moment!
!  22-apr-16/MR: Changed calls to zsum_mn_name_xy for compatibility with Yin-Yang grid.
!
      use Diagnostics
      use Special, only: special_calc_hydro
      use Sub, only: dot, dot2, identify_bcs, cross, multsv, multsv_mn_add
      use General, only: transform_thph_yy, notanumber
      use Deriv, only: der
!
      real, dimension (mx,my,mz,mfarray) :: f
      real, dimension (mx,my,mz,mvar) :: df
      type (pencil_case) :: p
!
      intent(inout) :: p
      intent(inout) :: f,df

      real, dimension (nx,3) :: tmpv
      real, dimension (nx) :: tmp, ftot, ugu_Schur_x, ugu_Schur_y, ugu_Schur_z
      real, dimension (nx,3,3) :: puij_Schur
      integer :: i, j, ju
!
      Fmax=tini
!
!  Identify module and boundary conditions.
!
      call timing('duu_dt','entered',mnloop=.true.)
      if (headtt.or.ldebug) print*,'duu_dt: SOLVE'
      if (headtt) then
        call identify_bcs('ux',iux)
        call identify_bcs('uy',iuy)
        call identify_bcs('uz',iuz)
        if (lslope_limit_diff) then
          call identify_bcs('sld_char',isld_char)
        endif
      endif
!
!  Advection term, i.e., subtract u.gradu.
!  In the relativistic case, this is automatically
!  u.gradS, and then we also need to subtract (divu)*S,
!  but that is currently done in noentropy.
!
      if (ladvection_velocity) then
        if (.not. lconservative .and. .not. lweno_transport .and. &
            .not. lno_meridional_flow .and. .not. lfargo_advection) then
          if (lSchur_3D3D1D_uu) then
            call dot(p%uu,p%uij(:,1,:),ugu_Schur_x)
            call dot(p%uu,p%uij(:,2,:),ugu_Schur_y)
            ugu_Schur_z=p%uu(:,3)*p%uij(:,3,3)
            df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)-ugu_Schur_x
            df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-ugu_Schur_y
            df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-ugu_Schur_z
          elseif (lSchur_2D2D3D_uu) then
            do j=1,3
            do i=1,3
              puij_Schur(:,i,j) = p%uij(:,i,j)
            enddo
            enddo
            puij_Schur(:,1,3) = 0
            puij_Schur(:,2,3) = 0
            call dot(p%uu,puij_Schur(:,1,:),ugu_Schur_x)
            call dot(p%uu,puij_Schur(:,2,:),ugu_Schur_y)
            call dot(p%uu,puij_Schur(:,3,:),ugu_Schur_z)
            df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)-ugu_Schur_x
            df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-ugu_Schur_y
            df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-ugu_Schur_z
          elseif (lSchur_2D2D1D_uu) then
            do j=1,3
            do i=1,3
              puij_Schur(:,i,j) = p%uij(:,i,j)
            enddo
            enddo
            puij_Schur(:,1,3) = 0
            puij_Schur(:,2,3) = 0
            call dot(p%uu,puij_Schur(:,1,:),ugu_Schur_x)
            call dot(p%uu,puij_Schur(:,2,:),ugu_Schur_y)
            ugu_Schur_z=p%uu(:,3)*p%uij(:,3,3)
            df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)-ugu_Schur_x
            df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-ugu_Schur_y
            df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-ugu_Schur_z
          else
            df(l1:l2,m,n,iux:iuz)=df(l1:l2,m,n,iux:iuz)-p%ugu
          endif
        endif
!
        if (ldensity.and.lconservative) then
!
!  diagonals first
!
          call der(f,iTij+0,tmp,1) ; df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)-tmp
          call der(f,iTij+1,tmp,2) ; df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-tmp
          call der(f,iTij+2,tmp,3) ; df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tmp
!
!  "Tij4" = T12
!  "Tij5" = T23
!  "Tij6" = T31
!  next the off-diagonals
!  T_11,1 + T_12,2 + T_13,3 = (0,1) + (3,2) + (5,3); (T23=T32 does not enter)
!
          call der(f,iTij+3,tmp,2) ; df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)-tmp
          call der(f,iTij+5,tmp,3) ; df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)-tmp
!
!  T_21,1 + T_22,2 + T_23,3 = (1,2) + (3,1) + (4,3); (T13=T31 does not enter)
!
          call der(f,iTij+3,tmp,1) ; df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-tmp
          call der(f,iTij+4,tmp,3) ; df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-tmp
!
!  T_31,1 + T_32,2 + T_33,3 = (2,3) + (5,1) + (4,2); (T12=T21 does not enter)
!
          call der(f,iTij+5,tmp,1) ; df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tmp
          call der(f,iTij+4,tmp,2) ; df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tmp
!
        endif
!
!  WENO transport.
!
        if (lweno_transport) then
          do j=1,3
            df(l1:l2,m,n,iux-1+j)=df(l1:l2,m,n,iux-1+j) &
                - (p%transpurho(:,j) - p%uu(:,j)*p%transprho)*p%rho1
          enddo
        endif
!
!  No meridional flow : turn off the meridional flow (in spherical)
!  useful for debugging.
!
!  18-Mar-2010/AJ: this should probably go in a special module.
!  12-Mar-2017/WL: Agree, looks very specific.
!
        if (lno_meridional_flow) then
          f(l1:l2,m,n,iux:iuy)=0.0
          df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-p%ugu(:,3)
        endif
!
        if (lfargo_advection) &
          df(l1:l2,m,n,iux:iuz)=df(l1:l2,m,n,iux:iuz)-p%uuadvec_guu
!
!  endif from ladvection_velocity
!
      endif
!
!  Coriolis force, -2*Omega x u (unless lprecession=T)
!  Omega=(-sin_theta, 0, cos_theta), where theta corresponds to
!  colatitude. theta=0 places the box to the north pole and theta=90
!  the equator. Cartesian coordinates (x,y,z) now correspond to
!  (theta,phi,r) i.e. (south,east,up), in spherical polar coordinates
!
      if (Omega/=0.) then
!
        if (lcylindrical_coords) then
          call coriolis_cylindrical(df,p)
        elseif (lspherical_coords) then
          call coriolis_spherical(df,p)
        elseif (lprecession) then
          call precession(df,p)
        elseif (lrotation_xaxis) then
          call coriolis_cartesian_xaxis(df,p%uu,iux)
        else
          call coriolis_cartesian(df,p%uu,iux)
        endif
!
      endif
!
!  Coriolis force with in Cartesian domain with Omega=Omega(x)
!
      if (lcoriolis_xdep) call coriolis_xdep(df,p)
!
!  Interface for your personal subroutines calls
!
      if (lspecial) call special_calc_hydro(f,df,p)
!
! calculate viscous force
!
      if (lviscosity) call calc_viscous_force(df,p)
      if (lSGS_hydro) call calc_SGS_hydro_force(f,df,p)
!
!  ``uu/dx'' for timestep
!
      if (lfirst.and.ldt.and.ladvection_velocity) then
        if (lmaximal_cdt) then
          advec_uu=max(abs(p%uu(:,1))*dline_1(:,1),&
                       abs(p%uu(:,2))*dline_1(:,2),&
                       abs(p%uu(:,3))*dline_1(:,3))
        else
          if (lfargo_advection) then
            advec_uu=sum(abs(p%uu_advec)*dline_1,2)
          else
            advec_uu=sum(abs(p%uu)*dline_1,2)
          endif
        endif
!
!  Empirically, it turns out that we need to take the full 3-D velocity
!  into account for computing the time step. It is not clear why.
!  Wlad finds that, otherwise, the code blows up for 2-D disk problem.
!  Some 1D and 2D samples work when the non-existent direction has the
!  largest velocity (like a 2D rz slice of a Keplerian disk that rotates
!  on the phi direction).
!
        if (lisotropic_advection) then
          if (dimensionality<3) advec_uu=sqrt(p%u2*dxyz_2)
        endif

        if (notanumber(advec_uu)) print*, 'advec_uu   =',advec_uu
        maxadvec=maxadvec+advec_uu
        if (headtt.or.ldebug) print*,'duu_dt: max(advec_uu) =',maxval(advec_uu)
      endif
!
!  Ekman Friction, used only in two dimensional runs.
!
      if (ekman_friction/=0) &
        df(l1:l2,m,n,iux:iuz)=df(l1:l2,m,n,iux:iuz)-ekman_friction*p%uu
!
!  Boussinesq approximation: -g_z*alpha*(T-T_0) added.
!  Use Rayleigh number only with ltemperature.
!  Note: the buoyancy term is currently scaled with Ra*Pr, but Pr is also
!  regulated though mu and K, so Pr should eventually be eliminated.
!
      if (lboussinesq.and.ltemperature) then
        if (lsphere_in_a_box) then
          do j=1,3
            ju=j+iuu-1
            df(l1:l2,m,n,ju)=df(l1:l2,m,n,ju)+ &
            p%r_mn*Ra*Pr*f(l1:l2,m,n,iTT)*p%evr(:,j)
          enddo
        else
          df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)+Ra*Pr*f(l1:l2,m,n,iTT) !  gravity in the opposite z direction
        endif
      endif
!
!  Add possibility of forcing that is not delta-correlated in time.
!
      if (lforcing_cont_uu) &
        df(l1:l2,m,n,iux:iuz)=df(l1:l2,m,n,iux:iuz)+ &
                              ampl_fcont_uu*p%fcont(:,:,1)
!
!  Damp motions in some regions for some time spans if desired.
!  For geodynamo: addition of dampuint evaluation.
!
      if (tdamp/=0.or.dampuext/=0.or.dampuint/=0) call udamping(f,df,p)
!
!  adding differential rotation via a frictional term
!
      if (tau_diffrot1/=0.) &
        call impose_profile_diffrot(f,df,uuprof,ldiffrot_test)
!
!  impose velocity ceiling
!
      if (velocity_ceiling/=0.) call impose_velocity_ceiling(f)
!
!  Save the advective derivative as an auxiliary.
!  MR: not the full story if there is a Lorentz force
!
      if (ladv_der_as_aux) then
        f(l1:l2,m,n,i_adv_derx:i_adv_derz) = p%fpres + p%fvisc
        if (lgrav) f(l1:l2,m,n,i_adv_derx:i_adv_derz) = f(l1:l2,m,n,i_adv_derx:i_adv_derz) + p%gg
      endif
!
!  Velocity in spherical coordinates from a Cartesian simulation
!  for sphere-in-a-box setups
!
      if (luu_sph_as_aux.and.lsphere_in_a_box) then
        f(l1:l2,m,n,iuu_sphr) = p%uu(:,1)*p%evr(:,1)+p%uu(:,2)*p%evr(:,2)+p%uu(:,3)*p%evr(:,3)
        f(l1:l2,m,n,iuu_spht) = p%uu(:,1)*p%evth(:,1)+p%uu(:,2)*p%evth(:,2)+p%uu(:,3)*p%evth(:,3)
        f(l1:l2,m,n,iuu_sphp) = p%uu(:,1)*p%phix+p%uu(:,2)*p%phiy
      endif
!
!  Possibility to damp mean x momentum, ruxm, to zero.
!  This can be useful in situations where a mean flow is generated.
!  This tends to be the case when there is linear shear but no rotation
!  and the turbulence is forced. A constant drift velocity in the
!  x-direction is most dangerous, because it leads to a linear increase
!  of <uy> due to the shear term. If there is rotation, the epicyclic
!  motion brings one always back to no mean flow on the average.
!
      if (tau_damp_ruxm/=0.) &
        df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)-ruxm*p%rho1*tau_damp_ruxm1
      if (tau_damp_ruym/=0.) &
        df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-ruym*p%rho1*tau_damp_ruym1
      if (tau_damp_ruzm/=0.) &
        df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-ruzm*p%rho1*tau_damp_ruzm1
!
!  Apply border profiles
!
      if (lborder_profiles) call set_border_hydro(f,df,p)
!
!  Fred: Option to constrain timestep for large forces
!
      if (lfirst.and.ldt.and.lcdt_tauf) then
        do j=1,3
          ftot=abs(df(l1:l2,m,n,iux+j-1))
          dt1_max=max(dt1_max,ftot/(cdt_tauf*ulev))
          Fmax=max(Fmax,ftot/ulev)
        enddo
      endif

      call calc_diagnostics_hydro(f,p)
!
      call timing('duu_dt','finished',mnloop=.true.)
!
    endsubroutine duu_dt
!*******************************************************************************
    subroutine calc_0d_diagnostics_hydro(f,p)
!
!   6-sep-19/MR: taken out from duu_dt
!
      use Diagnostics
      use Sub, only: dot, dot2, cross

      real, dimension(:,:,:,:) :: f
      type(pencil_case), intent(in) :: p
!
      real, dimension (nx,3) :: uxo
      real, dimension (nx) :: space_part_re,space_part_im,u2t,uot,out,fu
      real, dimension (nx) :: odel2um,uref,curlo2,qo,quxo,graddivu2
      real, dimension (nx,Nmodes_SH) :: urlm
      real, dimension (nx) :: rmask
      real :: kx
      integer :: k
      logical, save :: lcorr_zero_dt=.false.
!
!  Calculate maxima and rms values for diagnostic purposes
!
      call timing('calc_0d_diagnostics_hydro','before ldiagnos',mnloop=.true.)
!
      if (ldiagnos) then
        call sum_mn_name(p%u2,idiag_urms,lsqrt=.true.)
        if (idiag_durms/=0) then
          uref=ampluu(1)*cos(kx_uu*x(l1:l2))
          call sum_mn_name(p%u2-2.*p%uu(:,2)*uref+uref**2,idiag_durms)
        endif
        if (.not.lgpu) then
          if (ladvection_velocity.and.idiag_dtu/=0) call max_mn_name(advec_uu/cdt,idiag_dtu,l_dt=.true.)
          if (idiag_dtF/=0) call max_mn_name(Fmax/cdt_tauf,idiag_dtF,l_dt=.true.)
          if ((idiag_taufmin/=0).and.lcdt_tauf) &
            call max_mn_name(Fmax,idiag_taufmin,lreciprocal=.true.)
        endif
!
! urlm
!
        if (lspherical_coords.and.any(idiag_urlm/=0)) then
          call amp_lm(p%uu(:,1),urlm,profile_SH)    ! MR: tb restricted to needed urlm
          do k=1,Nmodes_SH
            call sum_mn_name(urlm(:,k),idiag_urlm(k))
          enddo
        endif
        if (idiag_urmsh/=0) then
          if (lequatory) call sum_mn_name_halfy(p%u2,idiag_urmsh)
          if (lequatorz) call sum_mn_name_halfz(p%u2,idiag_urmsh)
          fname(idiag_urmsn)=fname_half(idiag_urmsh,1)
          fname(idiag_urmss)=fname_half(idiag_urmsh,2)
          itype_name(idiag_urmsn)=ilabel_sum_sqrt
          itype_name(idiag_urmss)=ilabel_sum_sqrt
        endif
        if (idiag_urmsx/=0) call sum_mn_name(p%u2*xmask_hyd,idiag_urmsx,lsqrt=.true.)
        if (idiag_urmsz/=0) call sum_mn_name(p%u2*zmask_hyd(n-n1+1),idiag_urmsz,lsqrt=.true.)
        call max_mn_name(p%u2,idiag_umax,lsqrt=.true.)
        if (idiag_umin /=0) call max_mn_name(-sqrt(p%u2),idiag_umin,lneg=.true.)
        if (idiag_uxrms/=0) &
            call sum_mn_name(p%uu(:,1)**2,idiag_uxrms,lsqrt=.true.)
        if (idiag_uyrms/=0) &
            call sum_mn_name(p%uu(:,2)**2,idiag_uyrms,lsqrt=.true.)
        if (idiag_uzrms/=0) &
            call sum_mn_name(p%uu(:,3)**2,idiag_uzrms,lsqrt=.true.)
        if (idiag_uzrmaxs/=0) &
            call max_mn_name(p%uu(:,3)**2,idiag_uzrmaxs,lsqrt=.true.)
        if (idiag_uxmin/=0) call max_mn_name(-p%uu(:,1),idiag_uxmin,lneg=.true.)
        if (idiag_uymin/=0) call max_mn_name(-p%uu(:,2),idiag_uymin,lneg=.true.)
        if (idiag_uzmin/=0) call max_mn_name(-p%uu(:,3),idiag_uzmin,lneg=.true.)
        call max_mn_name(p%uu(:,1),idiag_uxmax)
        call max_mn_name(p%uu(:,2),idiag_uymax)
        call max_mn_name(p%uu(:,3),idiag_uzmax)
        if (idiag_rumax/=0) call max_mn_name(p%u2*p%rho**2,idiag_rumax,lsqrt=.true.)
        call sum_mn_name(p%ugu(:,1),idiag_uguxm)
        call sum_mn_name(p%ugu(:,2),idiag_uguym)
        call sum_mn_name(p%ugu(:,3),idiag_uguzm)
        call sum_mn_name(p%uij(:,1,1),idiag_dudx)
        call sum_mn_name(p%ugu2,idiag_ugu2m)
        if (idiag_ugurmsx/=0) call sum_mn_name(p%ugu2*xmask_hyd,idiag_ugurmsx,lsqrt=.true.)
        if (idiag_fkinzm/=0) call sum_mn_name(.5*p%rho*p%u2*p%uu(:,3),idiag_fkinzm)
        call max_mn_name(p%u2,idiag_um2)
        call sum_mn_name(p%u2,idiag_u2m)
        if (idiag_u2sphm/=0 .or. idiag_o2sphm/=0) then
          where (p%r_mn <= 1.)
            rmask = 1.
          elsewhere
            rmask = 0.
          endwhere
          call integrate_mn_name(rmask*p%u2,idiag_u2sphm)
          call integrate_mn_name(rmask*p%o2,idiag_o2sphm)
        endif
        call sum_mn_name(p%divu,idiag_divum)
        if (idiag_rdivum/=0)  call sum_mn_name(p%rho*p%divu,idiag_rdivum)
        if (idiag_divu2m/=0)  call sum_mn_name(p%divu**2,idiag_divu2m)
        if (idiag_gdivu2m/=0) then
          call dot2(p%graddivu,graddivu2)
          call sum_mn_name(graddivu2,idiag_gdivu2m)
        endif
        if (idiag_divrhourms/=0) call sum_mn_name((p%rho*p%divu+p%ugrho)**2,idiag_divrhourms,lsqrt=.true.)
        if (idiag_divrhoumax/=0) call max_mn_name(p%rho*p%divu+p%ugrho,idiag_divrhoumax)
        if (idiag_uxm/=0)     call sum_mn_name(p%uu(:,1),idiag_uxm)
        if (idiag_uym/=0)     call sum_mn_name(p%uu(:,2),idiag_uym)
        if (idiag_uzm/=0)     call sum_mn_name(p%uu(:,3),idiag_uzm)
        if (idiag_uzcx10m/=0) call sum_mn_name(p%uu(:,3)*cx10*zmask_hyd(n-n1+1),idiag_uzcx10m)
        if (idiag_uzsx10m/=0) call sum_mn_name(p%uu(:,3)*sx10*zmask_hyd(n-n1+1),idiag_uzsx10m)
        if (idiag_ux2m/=0)    call sum_mn_name(p%uu(:,1)**2,idiag_ux2m)
        if (idiag_uy2m/=0)    call sum_mn_name(p%uu(:,2)**2,idiag_uy2m)
        if (idiag_uz2m/=0)    call sum_mn_name(p%uu(:,3)**2,idiag_uz2m)
        if (idiag_ux3m/=0)    call sum_mn_name(p%uu(:,1)**3,idiag_ux3m)
        if (idiag_uy3m/=0)    call sum_mn_name(p%uu(:,2)**3,idiag_uy3m)
        if (idiag_uz3m/=0)    call sum_mn_name(p%uu(:,3)**3,idiag_uz3m)
        if (idiag_ux4m/=0)    call sum_mn_name(p%uu(:,1)**4,idiag_ux4m)
        if (idiag_uy4m/=0)    call sum_mn_name(p%uu(:,2)**4,idiag_uy4m)
        if (idiag_uz4m/=0)    call sum_mn_name(p%uu(:,3)**4,idiag_uz4m)
        if (idiag_uxuy2m/=0)  call sum_mn_name(p%uu(:,1)**2*p%uu(:,2)**2,idiag_uxuy2m)
        if (idiag_uyuz2m/=0)  call sum_mn_name(p%uu(:,2)**2*p%uu(:,3)**2,idiag_uyuz2m)
        if (idiag_uzux2m/=0)  call sum_mn_name(p%uu(:,3)**2*p%uu(:,1)**2,idiag_uzux2m)
        if (idiag_ux2ccm/=0)  call sum_mn_name(c2z(n)*p%uu(:,1)**2,idiag_ux2ccm)
        if (idiag_ux2ssm/=0)  call sum_mn_name(s2z(n)*p%uu(:,1)**2,idiag_ux2ssm)
        if (idiag_uy2ccm/=0)  call sum_mn_name(c2z(n)*p%uu(:,2)**2,idiag_uy2ccm)
        if (idiag_uy2ssm/=0)  call sum_mn_name(s2z(n)*p%uu(:,2)**2,idiag_uy2ssm)
        if (idiag_uxuycsm/=0) &
            call sum_mn_name(cz(n)*sz(n)*p%uu(:,1)*p%uu(:,2),idiag_uxuycsm)
        if (idiag_uxuym/=0)   call sum_mn_name(p%uu(:,1)*p%uu(:,2),idiag_uxuym)
        if (idiag_uxuzm/=0)   call sum_mn_name(p%uu(:,1)*p%uu(:,3),idiag_uxuzm)
        if (idiag_uyuzm/=0)   call sum_mn_name(p%uu(:,2)*p%uu(:,3),idiag_uyuzm)
        if (idiag_ruxuym/=0) &
            call sum_mn_name(p%rho*p%uu(:,1)*p%uu(:,2),idiag_ruxuym)
        if (idiag_ruxuzm/=0) &
            call sum_mn_name(p%rho*p%uu(:,1)*p%uu(:,3),idiag_ruxuzm)
        if (idiag_ruyuzm/=0) &
            call sum_mn_name(p%rho*p%uu(:,2)*p%uu(:,3),idiag_ruyuzm)
        if (idiag_divuHrms/=0) call sum_mn_name((p%uij(:,1,1)+p%uij(:,2,2))**2,idiag_divuHrms,lsqrt=.true.)
        if (idiag_uxxrms/=0) call sum_mn_name(p%uij(:,1,1)**2,idiag_uxxrms,lsqrt=.true.)
        if (idiag_uyyrms/=0) call sum_mn_name(p%uij(:,2,2)**2,idiag_uyyrms,lsqrt=.true.)
        if (idiag_uxzrms/=0) call sum_mn_name(p%uij(:,1,3)**2,idiag_uxzrms,lsqrt=.true.)
        if (idiag_uyzrms/=0) call sum_mn_name(p%uij(:,2,3)**2,idiag_uyzrms,lsqrt=.true.)
        if (idiag_uzyrms/=0) call sum_mn_name(p%uij(:,3,2)**2,idiag_uzyrms,lsqrt=.true.)
        if (idiag_duxdzma/=0) call sum_mn_name(abs(p%uij(:,1,3)),idiag_duxdzma)
        if (idiag_duydzma/=0) call sum_mn_name(abs(p%uij(:,2,3)),idiag_duydzma)
!
        if (idiag_rux2m/=0) call sum_mn_name(p%rho*p%uu(:,1)**2,idiag_rux2m)
        if (idiag_ruy2m/=0) call sum_mn_name(p%rho*p%uu(:,2)**2,idiag_ruy2m)
        if (idiag_ruz2m/=0) call sum_mn_name(p%rho*p%uu(:,3)**2,idiag_ruz2m)
        if (idiag_ekin/=0) call sum_mn_name(p%ekin,idiag_ekin)
        if (idiag_EEK/=0) call sum_mn_name(p%ekin,idiag_EEK)
        if (idiag_ekintot/=0) call integrate_mn_name(p%ekin,idiag_ekintot)
        if (idiag_totangmom/=0) &
            call sum_lim_mn_name(p%rho*(p%uu(:,2)*x(l1:l2)-p%uu(:,1)*y(m)),&
            idiag_totangmom,p)
        if (idiag_uxglnrym/=0) &
            call sum_mn_name(p%uu(:,1)*p%glnrho(:,2),idiag_uxglnrym)
        if (idiag_uyglnrxm/=0) &
            call sum_mn_name(p%uu(:,2)*p%glnrho(:,1),idiag_uyglnrxm)
        if (idiag_uzdivum/=0) call sum_mn_name(p%uu(:,3)*p%divu,idiag_uzdivum)
        if (idiag_uxuydivum/=0) &
            call sum_mn_name(p%uu(:,1)*p%uu(:,2)*p%divu,idiag_uxuydivum)
!
        if (idiag_udpxxm/=0) call sum_mn_name(2.*(p%uu(:,1)*p%fpres(:,1)),idiag_udpxxm)
        if (idiag_udpyym/=0) call sum_mn_name(2.*(p%uu(:,2)*p%fpres(:,2)),idiag_udpyym)
        if (idiag_udpzzm/=0) call sum_mn_name(2.*(p%uu(:,3)*p%fpres(:,3)),idiag_udpzzm)
        if (idiag_udpxym/=0) call sum_mn_name(p%uu(:,1)*p%fpres(:,2)+p%uu(:,2)*p%fpres(:,1),idiag_udpxym)
        if (idiag_udpyzm/=0) call sum_mn_name(p%uu(:,2)*p%fpres(:,3)+p%uu(:,3)*p%fpres(:,2),idiag_udpyzm)
        if (idiag_udpxzm/=0) call sum_mn_name(p%uu(:,1)*p%fpres(:,3)+p%uu(:,3)*p%fpres(:,1),idiag_udpxzm)
!
!  Velocity components at one point (=pt).
!
        if (lroot.and.m==mpoint.and.n==npoint) then
          if (idiag_uxpt/=0) call save_name(p%uu(lpoint-nghost,1),idiag_uxpt)
          if (idiag_uypt/=0) call save_name(p%uu(lpoint-nghost,2),idiag_uypt)
          if (idiag_uzpt/=0) call save_name(p%uu(lpoint-nghost,3),idiag_uzpt)
          if (idiag_uxuypt/=0) call save_name(p%uu(lpoint-nghost,1)*p%uu(lpoint-nghost,2),idiag_uxuypt)
          if (idiag_uyuzpt/=0) call save_name(p%uu(lpoint-nghost,2)*p%uu(lpoint-nghost,3),idiag_uyuzpt)
          if (idiag_uzuxpt/=0) call save_name(p%uu(lpoint-nghost,3)*p%uu(lpoint-nghost,1),idiag_uzuxpt)
        endif
!
!  Velocity components at point 2 (=p2).
!
        if (lroot.and.m==mpoint2.and.n==npoint2) then
          if (idiag_uxp2/=0) call save_name(p%uu(lpoint2-nghost,1),idiag_uxp2)
          if (idiag_uyp2/=0) call save_name(p%uu(lpoint2-nghost,2),idiag_uyp2)
          if (idiag_uzp2/=0) call save_name(p%uu(lpoint2-nghost,3),idiag_uzp2)
        endif
!
!  Mean momenta.
!
        if (idiag_ruxm/=0) call sum_mn_name(p%rho*p%uu(:,1),idiag_ruxm)
        if (idiag_ruym/=0) call sum_mn_name(p%rho*p%uu(:,2),idiag_ruym)
        if (idiag_ruzm/=0) call sum_mn_name(p%rho*p%uu(:,3),idiag_ruzm)
        if (idiag_ruxtot/=0) call sum_mn_name(p%rho*abs(p%uu(:,1)),idiag_ruxtot)
!
!  Mean angular momenta.
!
        if (idiag_rlxm/=0) call sum_mn_name( &
            p%rho*(y(m)*p%uu(:,3)-z(n)*p%uu(:,2)),idiag_rlxm)
        if (idiag_rlym/=0) call sum_mn_name( &
            p%rho*(z(n)*p%uu(:,1)-x(l1:l2)*p%uu(:,3)),idiag_rlym)
        if (idiag_rlzm/=0) call sum_mn_name( &
            p%rho*(x(l1:l2)*p%uu(:,2)-y(m)*p%uu(:,1)),idiag_rlzm)
        if (idiag_rlx2m/=0) call sum_mn_name( &
            (p%rho*(y(m)*p%uu(:,3)-z(n)*p%uu(:,2)))**2,idiag_rlx2m)
        if (idiag_rly2m/=0) call sum_mn_name( &
            (p%rho*(z(n)*p%uu(:,1)-x(l1:l2)*p%uu(:,3)))**2,idiag_rly2m)
        if (idiag_rlz2m/=0) call sum_mn_name( &
            (p%rho*(x(l1:l2)*p%uu(:,2)-y(m)*p%uu(:,1)))**2,idiag_rlz2m)
!
!  Things related to Lorentz gamma; remember that ilorentz is already gamma**2
!
        if (ilorentz/=0) then
          if (idiag_gamm/=0) call sum_mn_name(sqrt(abs(f(l1:l2,m,n,ilorentz))),idiag_gamm)
          if (idiag_gamrms/=0) call sum_mn_name(f(l1:l2,m,n,ilorentz),idiag_gamrms,lsqrt=.true.)
          if (idiag_gammax/=0) call max_mn_name(f(l1:l2,m,n,ilorentz),idiag_gammax,lsqrt=.true.)
        endif
!
!  Total angular momentum in spherical coordinates
!
        if (idiag_tot_ang_mom/=0) call integrate_mn_name( &
            p%rho*x(l1:l2)*sin(y(m))*p%uu(:,3),idiag_tot_ang_mom)
!
!  Mean dot product of forcing and velocity field, <f.u>.
!
        if (idiag_fum/=0) then
          call dot(p%fcont(:,:,1),p%uu,fu)
          call sum_mn_name(ampl_fcont_uu*fu,idiag_fum)
        endif
!
!  Mean dot product of forcing and velocity field, <f.u>.
!
  !     if (idiag_rufm/=0) then
  !       call dot(p%fcont(:,:,1),p%uu,fu)
  !       call sum_mn_name(ampl_fcont_uu*fu,idiag_rufm)
  !     endif
!
!  Things related to kinetic helicity.
!
        if (idiag_ou_int/=0) call integrate_mn_name(p%ou,idiag_ou_int)
        if (idiag_oum/=0) call sum_mn_name(p%ou,idiag_oum)
        if (idiag_oxum/=0) call sum_mn_name(p%oxu(:,1),idiag_oxum)
        if (idiag_ourms/=0) call sum_mn_name(p%ou**2,idiag_ourms,lsqrt=.true.)
        if (idiag_oxurms/=0) call sum_mn_name(p%oxu2,idiag_oxurms,lsqrt=.true.)
!
!  Things related to vorticity.
!
        if (idiag_oumh/=0) then
          if (lequatory) call sum_mn_name_halfy(p%ou,idiag_oumh)
          if (lequatorz) call sum_mn_name_halfz(p%ou,idiag_oumh)
          fname(idiag_oumn)=fname_half(idiag_oumh,1)
          fname(idiag_oums)=fname_half(idiag_oumh,2)
          itype_name(idiag_oumn)=ilabel_sum
          itype_name(idiag_oums)=ilabel_sum
        endif
        call sum_mn_name(p%o2,idiag_orms,lsqrt=.true.)
        if (idiag_ormsh/=0) then
          if (lequatory) call sum_mn_name_halfy(p%o2,idiag_ormsh)
          if (lequatorz) call sum_mn_name_halfz(p%o2,idiag_ormsh)
          fname(idiag_ormsn)=fname_half(idiag_ormsh,1)
          fname(idiag_ormss)=fname_half(idiag_ormsh,2)
          itype_name(idiag_ormsn)=ilabel_sum_sqrt
          itype_name(idiag_ormss)=ilabel_sum_sqrt
        endif
!
!  <o.del2u>
!
        if (idiag_odel2um/=0) then
          call dot(p%oo,p%del2u,odel2um)
          call sum_mn_name(odel2um,idiag_odel2um)
        endif
!
!  various vorticity diagnostics
!
        if (idiag_omax/=0) call max_mn_name(p%o2,idiag_omax,lsqrt=.true.)
        if (idiag_o2m/=0)  call sum_mn_name(p%o2,idiag_o2m)
        if (idiag_o2u2m/=0)call sum_mn_name(p%o2*p%u2,idiag_o2u2m)
        if (idiag_ox2m/=0) call sum_mn_name(p%oo(:,1)**2,idiag_ox2m)
        if (idiag_oy2m/=0) call sum_mn_name(p%oo(:,2)**2,idiag_oy2m)
        if (idiag_oz2m/=0) call sum_mn_name(p%oo(:,3)**2,idiag_oz2m)
        if (idiag_ox3m/=0) call sum_mn_name(p%oo(:,1)**3,idiag_ox3m)
        if (idiag_oy3m/=0) call sum_mn_name(p%oo(:,2)**3,idiag_oy3m)
        if (idiag_oz3m/=0) call sum_mn_name(p%oo(:,3)**3,idiag_oz3m)
        if (idiag_ox4m/=0) call sum_mn_name(p%oo(:,1)**4,idiag_ox4m)
        if (idiag_oy4m/=0) call sum_mn_name(p%oo(:,2)**4,idiag_oy4m)
        if (idiag_oz4m/=0) call sum_mn_name(p%oo(:,3)**4,idiag_oz4m)
        call sum_mn_name(p%oo(:,1),idiag_oxm)
        call sum_mn_name(p%oo(:,2),idiag_oym)
        call sum_mn_name(p%oo(:,3),idiag_ozm)
        if (idiag_oxuzxm/=0) call sum_mn_name(p%oo(:,1)*p%uij(:,3,1),idiag_oxuzxm)
        if (idiag_oyuzym/=0) call sum_mn_name(p%oo(:,2)*p%uij(:,3,2),idiag_oyuzym)
        if (idiag_oxoym/=0) call sum_mn_name(p%oo(:,1)*p%oo(:,2),idiag_oxoym)
        if (idiag_oxozm/=0) call sum_mn_name(p%oo(:,1)*p%oo(:,3),idiag_oxozm)
        if (idiag_oyozm/=0) call sum_mn_name(p%oo(:,2)*p%oo(:,3),idiag_oyozm)
        if (idiag_pvzm/=0) call sum_mn_name((p%oo(:,3) + 2.*Omega)/p%rho,idiag_pvzm)
!
!  diagnostics involving curlo [ =curl(omega) ]
!
        if (idiag_q2m/=0 .or. idiag_qrms/=0 .or. idiag_qmax/=0 ) then
          call dot2(p%curlo,curlo2)
          call sum_mn_name(curlo2,idiag_q2m)
          call sum_mn_name(curlo2,idiag_qrms,lsqrt=.true.)
          call max_mn_name(curlo2,idiag_qmax,lsqrt=.true.)
        endif
!
!  <q.o>
!
        if (idiag_qom/=0) then
          call dot(p%curlo,p%oo,qo)
          call sum_mn_name(qo,idiag_qom)
        endif
!
!  <q.(uxo)>
!
        if (idiag_quxom/=0) then
          call cross(p%uu,p%oo,uxo)
          call dot(p%curlo,uxo,quxo)
          call sum_mn_name(quxo,idiag_quxom)
        endif
!
!  Mach number, rms and max
!
        call sum_mn_name(p%Ma2,idiag_Marms,lsqrt=.true.)
        call max_mn_name(p%Ma2,idiag_Mamax,lsqrt=.true.)
!
!  Diagonal components of alpha using FOSA:
!    alp11=<u3*u2,1>-<u2*u3,1>
!    alp22=<u1*u3,2>-<u3*u1,2>
!    alp33=<u2*u1,3>-<u1*u2,3>
!  For fully periodic domains it is sufficient to compute, e.g., only:
!    alp11=<u3*u2,1>,  alp22=<u1*u3,2>,  alp33=<u2*u1,3>
!
        call sum_mn_name(p%u3u21,idiag_u3u21m)
        call sum_mn_name(p%u1u32,idiag_u1u32m)
        call sum_mn_name(p%u2u13,idiag_u2u13m)
        call sum_mn_name(p%u2u31,idiag_u2u31m)
        call sum_mn_name(p%u3u12,idiag_u3u12m)
        call sum_mn_name(p%u1u23,idiag_u1u23m)
!
! fourier amplitude f(t) for non-axisymmetric waves:
!         u_x = f(t)*exp[i(kx*x+ky*y+kz*z)]
!
        if (idiag_uxfampm/=0 .or. idiag_uyfampm/=0 .or. idiag_uzfampm/=0 .or.&
            idiag_uxfampim/=0 .or. idiag_uxfampim/=0 .or. idiag_uzfampim/=0) then
          kx = kx_uu + qshear*Omega*ky_uu*t
          space_part_re = cos(kx*x(l1:l2)+ky_uu*y(m)+kz_uu*z(n))
          space_part_im = -sin(kx*x(l1:l2)+ky_uu*y(m)+kz_uu*z(n))
          if (idiag_uxfampm/=0) &
            call sum_mn_name(p%uu(:,1)*space_part_re,idiag_uxfampm)
          if (idiag_uyfampm/=0) &
            call sum_mn_name(p%uu(:,2)*space_part_re,idiag_uyfampm)
          if (idiag_uzfampm/=0) &
            call sum_mn_name(p%uu(:,3)*space_part_re,idiag_uzfampm)
          if (idiag_uxfampim/=0) &
            call sum_mn_name(p%uu(:,1)*space_part_im,idiag_uxfampim)
          if (idiag_uyfampim/=0) &
            call sum_mn_name(p%uu(:,2)*space_part_im,idiag_uyfampim)
          if (idiag_uzfampim/=0) &
            call sum_mn_name(p%uu(:,3)*space_part_im,idiag_uzfampim)
!
        endif
!
!  integrate velocity in time, to calculate correlation time later
!
        if (idiag_u2tm/=0) then
          call dot(p%uu,f(l1:l2,m,n,iuxt:iuzt),u2t)
          call sum_mn_name(u2t,idiag_u2tm)
        endif
!
!  integrate velocity in time, to calculate correlation time later
!
        if (idiag_outm/=0) then
          call dot(p%oo,f(l1:l2,m,n,iuxt:iuzt),out)
          call sum_mn_name(out,idiag_outm)
        endif
!
!  integrate velocity in time, to calculate correlation time later
!
        if (idiag_uotm/=0) then
          call dot(p%uu,f(l1:l2,m,n,ioxt:iozt),uot)
          call sum_mn_name(uot,idiag_uotm)
        endif
!
        if (lfargo_advection.and.idiag_nshift/=0) then
          if (lcylindrical_coords) then
            !phidot=uu_average_cyl(:,n)*rcyl_mn1
            !nshift=phidot*dt*dy_1(m)
            !call max_mn_name(nshift,idiag_nshift)
            if (dt==0.) then
              lcorr_zero_dt=.true.
              call max_mn_name(uu_average_cyl(l1:l2,n)*rcyl_mn1*dy_1(m),idiag_nshift)
            else
              call max_mn_name(uu_average_cyl(l1:l2,n)*rcyl_mn1*dt*dy_1(m),idiag_nshift)
            endif
          elseif (lspherical_coords) then
            !mnghost=m-nghost
            !phidot=uu_average_sph(:,n)*rcyl_mn1  ! rcyl = r*sinth(m)
            !nshift=phidot*dt*dz_1(n)
            !call max_mn_name(nshift,idiag_nshift)
            if (dt==0.) then
              lcorr_zero_dt=.true.
              call max_mn_name(uu_average_sph(l1:l2,m)*rcyl_mn1*dz_1(n),idiag_nshift)
            else
              call max_mn_name(uu_average_sph(l1:l2,m)*rcyl_mn1*dt*dz_1(n),idiag_nshift)
            endif
          endif
        endif

      elseif (lcorr_zero_dt) then
!
!  Here all quantities should be updated the calculation of which requires dt which
!  is zero at the very first diagnostics output time. (Doesn't work for itorder=1.)
! 
        lcorr_zero_dt=.false.
        if (lroot) fname(idiag_nshift)=fname(idiag_nshift)*dt
      endif  ! if (ldiagnos)

    endsubroutine calc_0d_diagnostics_hydro
!*******************************************************************************
    subroutine calc_1d_diagnostics_hydro(f,p)
!
!   6-sep-19/MR: taken out from duu_dt
!
      use Diagnostics
      use Sub, only: dot, dot2, cross, multsv_mn_add

      real, dimension(:,:,:,:) :: f
      type(pencil_case) :: p

      real, dimension (nx,3) :: curlru
      real, dimension (nx) :: uus, curlru2, Remz, uzmask
!
!  1d-averages. Happens at every it1d timesteps, NOT at every it1.
!
      if (l1davgfirst) then
        if (idiag_fmasszmz/=0) call xysum_mn_name_z(p%rho*p%uu(:,3), idiag_fmasszmz)
        if (idiag_fkinzmz /=0) call xysum_mn_name_z(p%ekin*p%uu(:,3),idiag_fkinzmz )
        if (idiag_fkinxmx /=0) call yzsum_mn_name_x(p%ekin*p%uu(:,1),idiag_fkinxmx )
        call xysum_mn_name_z(p%uu(:,1),idiag_uxmz)
        call xysum_mn_name_z(p%uu(:,2),idiag_uymz)
        call xysum_mn_name_z(p%uu(:,3),idiag_uzmz)
        call xysum_mn_name_z(p%divu,idiag_divumz)
        if (idiag_uzdivumz/=0) call xysum_mn_name_z(p%uu(:,3)*p%divu,idiag_uzdivumz)
        call xysum_mn_name_z(p%oo(:,1),idiag_oxmz)
        call xysum_mn_name_z(p%oo(:,2),idiag_oymz)
        call xysum_mn_name_z(p%oo(:,3),idiag_ozmz)
        if (idiag_ox2mz/=0) call xysum_mn_name_z(p%oo(:,1)**2,idiag_ox2mz)
        if (idiag_oy2mz/=0) call xysum_mn_name_z(p%oo(:,2)**2,idiag_oy2mz)
        if (idiag_oz2mz/=0) call xysum_mn_name_z(p%oo(:,3)**2,idiag_oz2mz)
        call xzsum_mn_name_y(p%uu(:,1),idiag_uxmy)
        call xzsum_mn_name_y(p%uu(:,2),idiag_uymy)
        call xzsum_mn_name_y(p%uu(:,3),idiag_uzmy)
        call yzsum_mn_name_x(p%uu(:,1),idiag_uxmx)
        call yzsum_mn_name_x(p%uu(:,2),idiag_uymx)
        call yzsum_mn_name_x(p%uu(:,3),idiag_uzmx)
        if (idiag_ruxmx/=0) call yzsum_mn_name_x(p%rho*p%uu(:,1),idiag_ruxmx)
        if (idiag_ruymx/=0) call yzsum_mn_name_x(p%rho*p%uu(:,2),idiag_ruymx)
        if (idiag_ruzmx/=0) call yzsum_mn_name_x(p%rho*p%uu(:,3),idiag_ruzmx)
        if (idiag_rux2mx /= 0) call yzsum_mn_name_x(p%rho*p%uu(:,1)**2, idiag_rux2mx)
        if (idiag_ruy2mx /= 0) call yzsum_mn_name_x(p%rho*p%uu(:,2)**2, idiag_ruy2mx)
        if (idiag_ruz2mx /= 0) call yzsum_mn_name_x(p%rho*p%uu(:,3)**2, idiag_ruz2mx)
        if (idiag_ruxuymx/=0) call yzsum_mn_name_x(p%rho*p%uu(:,1)*p%uu(:,2),idiag_ruxuymx)
        if (idiag_ruxuzmx/=0) call yzsum_mn_name_x(p%rho*p%uu(:,1)*p%uu(:,3),idiag_ruxuzmx)
        if (idiag_ruyuzmx/=0) call yzsum_mn_name_x(p%rho*p%uu(:,2)*p%uu(:,3),idiag_ruyuzmx)
        if (idiag_ux2mz/=0) call xysum_mn_name_z(p%uu(:,1)**2,idiag_ux2mz)
        if (idiag_uy2mz/=0) call xysum_mn_name_z(p%uu(:,2)**2,idiag_uy2mz)
        if (idiag_uz2mz/=0) call xysum_mn_name_z(p%uu(:,3)**2,idiag_uz2mz)
        if (idiag_uzupmz/=0 .or. idiag_ruzupmz/=0 .or. idiag_uz2upmz/=0 .or. &
            idiag_fkinzupmz/=0 .or. idiag_Rxyupmz/=0 .or. idiag_Rxzupmz/=0 .or. &
            idiag_Ryzupmz/=0) then
          where (p%uu(:,3) > 0.)
            uus = p%uu(:,3)
            uzmask = p%uu(:,3)/abs(p%uu(:,3))
          elsewhere
            uus=0.
            uzmask = 0.
          endwhere
          call xysum_mn_name_z(uus,idiag_uzupmz)
          if (idiag_ruzupmz/=0) call xysum_mn_name_z(p%rho*uus,idiag_ruzupmz)
          if (idiag_uz2upmz/=0) call xysum_mn_name_z(uus**2,idiag_uz2upmz)
          if (idiag_fkinzupmz/=0) call xysum_mn_name_z(p%ekin*uus,idiag_fkinzupmz)
          if (idiag_Rxyupmz/=0) call &
              xysum_mn_name_z(uzmask*f(l1:l2,m,n,iuu_flucx)*f(l1:l2,m,n,iuu_flucy),idiag_Rxyupmz)
          if (idiag_Rxzupmz/=0) call &
              xysum_mn_name_z(uzmask*f(l1:l2,m,n,iuu_flucx)*f(l1:l2,m,n,iuu_flucz),idiag_Rxzupmz)
          if (idiag_Ryzupmz/=0) call &
              xysum_mn_name_z(uzmask*f(l1:l2,m,n,iuu_flucy)*f(l1:l2,m,n,iuu_flucz),idiag_Ryzupmz)
        endif
        if (idiag_ffdownmz/=0 .or. idiag_uzupmz/=0 .or. idiag_ruzupmz/=0 .or. &
            idiag_uz2upmz/=0 .or. idiag_fkinzupmz/=0 .or. idiag_Rxydownmz/=0 .or. &
            idiag_Rxzdownmz/=0 .or. idiag_Ryzdownmz/=0) then
          where (p%uu(:,3) < 0.)
            uus = p%uu(:,3)
            uzmask = -p%uu(:,3)/abs(p%uu(:,3))
          elsewhere
            uus = 0.
            uzmask = 0.
          endwhere
          if (idiag_ffdownmz/=0) call xysum_mn_name_z(-uus/abs(p%uu(:,3)),idiag_ffdownmz)
          call xysum_mn_name_z(uus,idiag_uzdownmz)
          if (idiag_ruzdownmz/=0) call xysum_mn_name_z(p%rho*uus,idiag_ruzdownmz)
          if (idiag_uz2downmz/=0) call xysum_mn_name_z(uus**2,idiag_uz2downmz)
          if (idiag_fkinzdownmz/=0) call xysum_mn_name_z(p%ekin*uus,idiag_fkinzdownmz)
          if (idiag_Rxydownmz/=0) call &
              xysum_mn_name_z(uzmask*f(l1:l2,m,n,iuu_flucx)*f(l1:l2,m,n,iuu_flucy),idiag_Rxydownmz)
          if (idiag_Rxzdownmz/=0) call &
              xysum_mn_name_z(uzmask*f(l1:l2,m,n,iuu_flucx)*f(l1:l2,m,n,iuu_flucz),idiag_Rxzdownmz)
          if (idiag_Ryzdownmz/=0) call &
              xysum_mn_name_z(uzmask*f(l1:l2,m,n,iuu_flucy)*f(l1:l2,m,n,iuu_flucz),idiag_Ryzdownmz)
        endif
!
!  mean squared velocity and vorticity
!
        call xysum_mn_name_z(p%u2,idiag_u2mz)
        call xysum_mn_name_z(p%o2,idiag_o2mz)
        if (idiag_divu2mz/=0) call xysum_mn_name_z(p%divu**2,idiag_divu2mz)
!
!  mean squared mass flux divergence
!
        if (idiag_divru2mz/=0) call xysum_mn_name_z((p%rho*p%divu+p%ugrho)**2,idiag_divru2mz)
!
!  mean squared curl of mass flux
!
        if (idiag_curlru2mz/=0) then
          call cross(p%grho,p%uu,curlru)
          call multsv_mn_add(p%rho,p%oo,curlru)
          call dot2(curlru,curlru2)
          call xysum_mn_name_z(curlru2,idiag_curlru2mz)
        endif

        if (idiag_ruxmz/=0) call xysum_mn_name_z(p%rho*p%uu(:,1),idiag_ruxmz)
        if (idiag_ruymz/=0) call xysum_mn_name_z(p%rho*p%uu(:,2),idiag_ruymz)
        if (idiag_ruzmz/=0) call xysum_mn_name_z(p%rho*p%uu(:,3),idiag_ruzmz)
        if (idiag_rux2mz/=0) call xysum_mn_name_z(p%rho*p%uu(:,1)**2,idiag_rux2mz)
        if (idiag_ruy2mz/=0) call xysum_mn_name_z(p%rho*p%uu(:,2)**2,idiag_ruy2mz)
        if (idiag_ruz2mz/=0) call xysum_mn_name_z(p%rho*p%uu(:,3)**2,idiag_ruz2mz)
        if (idiag_ux2my/=0) call xzsum_mn_name_y(p%uu(:,1)**2,idiag_ux2my)
        if (idiag_uy2my/=0) call xzsum_mn_name_y(p%uu(:,2)**2,idiag_uy2my)
        if (idiag_uz2my/=0) call xzsum_mn_name_y(p%uu(:,3)**2,idiag_uz2my)
        if (idiag_ux2mx/=0) call yzsum_mn_name_x(p%uu(:,1)**2,idiag_ux2mx)
        if (idiag_uy2mx/=0) call yzsum_mn_name_x(p%uu(:,2)**2,idiag_uy2mx)
        if (idiag_uz2mx/=0) call yzsum_mn_name_x(p%uu(:,3)**2,idiag_uz2mx)
        if (idiag_ox2mx/=0) call yzsum_mn_name_x(p%oo(:,1)**2,idiag_ox2mx)
        if (idiag_oy2mx/=0) call yzsum_mn_name_x(p%oo(:,2)**2,idiag_oy2mx)
        if (idiag_oz2mx/=0) call yzsum_mn_name_x(p%oo(:,3)**2,idiag_oz2mx)
        if (idiag_uxuymz/=0) call xysum_mn_name_z(p%uu(:,1)*p%uu(:,2),idiag_uxuymz)
        if (idiag_uxuzmz/=0) call xysum_mn_name_z(p%uu(:,1)*p%uu(:,3),idiag_uxuzmz)
        if (idiag_uyuzmz/=0) call xysum_mn_name_z(p%uu(:,2)*p%uu(:,3),idiag_uyuzmz)
        if (idiag_Rxymz/=0) call xysum_mn_name_z(f(l1:l2,m,n,iuu_flucx)*f(l1:l2,m,n,iuu_flucy),idiag_Rxymz)
        if (idiag_Rxzmz/=0) call xysum_mn_name_z(f(l1:l2,m,n,iuu_flucx)*f(l1:l2,m,n,iuu_flucz),idiag_Rxzmz)
        if (idiag_Ryzmz/=0) call xysum_mn_name_z(f(l1:l2,m,n,iuu_flucy)*f(l1:l2,m,n,iuu_flucz),idiag_Ryzmz)
        if (idiag_ruxuymz/=0) call xysum_mn_name_z(p%rho*p%uu(:,1)*p%uu(:,2),idiag_ruxuymz)
        if (idiag_ruxuzmz/=0) call xysum_mn_name_z(p%rho*p%uu(:,1)*p%uu(:,3),idiag_ruxuzmz)
        if (idiag_ruyuzmz/=0) call xysum_mn_name_z(p%rho*p%uu(:,2)*p%uu(:,3),idiag_ruyuzmz)
        if (idiag_ruxuy2mz/=0) call xysum_mn_name_z((p%rho*p%uu(:,1)*p%uu(:,2))**2,idiag_ruxuy2mz)
        if (idiag_ruxuz2mz/=0) call xysum_mn_name_z((p%rho*p%uu(:,1)*p%uu(:,3))**2,idiag_ruxuz2mz)
        if (idiag_ruyuz2mz/=0) call xysum_mn_name_z((p%rho*p%uu(:,2)*p%uu(:,3))**2,idiag_ruyuz2mz)
        if (idiag_oxuxxmz/=0) call xysum_mn_name_z(p%oo(:,1)*p%uij(:,1,1),idiag_oxuxxmz)
        if (idiag_oyuxymz/=0) call xysum_mn_name_z(p%oo(:,2)*p%uij(:,1,2),idiag_oyuxymz)
        if (idiag_oxuyxmz/=0) call xysum_mn_name_z(p%oo(:,1)*p%uij(:,2,1),idiag_oxuyxmz)
        if (idiag_oyuyymz/=0) call xysum_mn_name_z(p%oo(:,2)*p%uij(:,2,2),idiag_oyuyymz)
        if (idiag_oxuzxmz/=0) call xysum_mn_name_z(p%oo(:,1)*p%uij(:,3,1),idiag_oxuzxmz)
        if (idiag_oyuzymz/=0) call xysum_mn_name_z(p%oo(:,2)*p%uij(:,3,2),idiag_oyuzymz)
        if (idiag_uyxuzxmz/=0) call xysum_mn_name_z(p%uij(:,2,1)*p%uij(:,3,1),idiag_uyxuzxmz)
        if (idiag_uyyuzymz/=0) call xysum_mn_name_z(p%uij(:,2,2)*p%uij(:,3,2),idiag_uyyuzymz)
        if (idiag_uyzuzzmz/=0) call xysum_mn_name_z(p%uij(:,2,3)*p%uij(:,3,3),idiag_uyzuzzmz)
        if (idiag_uxuymy/=0) call xzsum_mn_name_y(p%uu(:,1)*p%uu(:,2),idiag_uxuymy)
        if (idiag_uxuzmy/=0) call xzsum_mn_name_y(p%uu(:,1)*p%uu(:,3),idiag_uxuzmy)
        if (idiag_uyuzmy/=0) call xzsum_mn_name_y(p%uu(:,2)*p%uu(:,3),idiag_uyuzmy)
        if (idiag_uxuymx/=0) call yzsum_mn_name_x(p%uu(:,1)*p%uu(:,2),idiag_uxuymx)
        if (idiag_uxuzmx/=0) call yzsum_mn_name_x(p%uu(:,1)*p%uu(:,3),idiag_uxuzmx)
        if (idiag_uyuzmx/=0) call yzsum_mn_name_x(p%uu(:,2)*p%uu(:,3),idiag_uyuzmx)
        call yzsum_mn_name_x(p%ekin,idiag_ekinmx)
        call xysum_mn_name_z(p%ekin,idiag_ekinmz)
        call yzsum_mn_name_x(p%ou,idiag_oumx)
        call xzsum_mn_name_y(p%ou,idiag_oumy)
        call xysum_mn_name_z(p%ou,idiag_oumz)
        call yzsum_mn_name_x(p%ugu(:,1),idiag_uguxmx)
        call yzsum_mn_name_x(p%ugu(:,2),idiag_uguymx)
        call yzsum_mn_name_x(p%ugu(:,3),idiag_uguzmx)
        call xzsum_mn_name_y(p%ugu(:,1),idiag_uguxmy)
        call xzsum_mn_name_y(p%ugu(:,2),idiag_uguymy)
        call xzsum_mn_name_y(p%ugu(:,3),idiag_uguzmy)
        call xysum_mn_name_z(p%ugu(:,1),idiag_uguxmz)
        call xysum_mn_name_z(p%ugu(:,2),idiag_uguymz)
        call xysum_mn_name_z(p%ugu(:,3),idiag_uguzmz)
        call xysum_mn_name_z(p%ogu(:,1),idiag_oguxmz)
        call xysum_mn_name_z(p%ogu(:,2),idiag_oguymz)
        call xysum_mn_name_z(p%ogu(:,3),idiag_oguzmz)
        if (idiag_ogux2mz/=0) call xysum_mn_name_z(p%ogu(:,1)**2,idiag_ogux2mz)
        if (idiag_oguy2mz/=0) call xysum_mn_name_z(p%ogu(:,2)**2,idiag_oguy2mz)
        if (idiag_oguz2mz/=0) call xysum_mn_name_z(p%ogu(:,3)**2,idiag_oguz2mz)
        if (idiag_oxdivumz/=0) call xysum_mn_name_z(p%oo(:,1)*p%divu,idiag_oxdivumz)
        if (idiag_oydivumz/=0) call xysum_mn_name_z(p%oo(:,2)*p%divu,idiag_oydivumz)
        if (idiag_ozdivumz/=0) call xysum_mn_name_z(p%oo(:,3)*p%divu,idiag_ozdivumz)
        if (idiag_oxdivu2mz/=0) call xysum_mn_name_z((p%oo(:,1)*p%divu)**2,idiag_oxdivu2mz)
        if (idiag_oydivu2mz/=0) call xysum_mn_name_z((p%oo(:,2)*p%divu)**2,idiag_oydivu2mz)
        if (idiag_ozdivu2mz/=0) call xysum_mn_name_z((p%oo(:,3)*p%divu)**2,idiag_ozdivu2mz)
        call xysum_mn_name_z(p%u3u21,idiag_u3u21mz)
        call xysum_mn_name_z(p%u1u32,idiag_u1u32mz)
        call xysum_mn_name_z(p%u2u13,idiag_u2u13mz)
        call xysum_mn_name_z(p%u2u31,idiag_u2u31mz)
        call xysum_mn_name_z(p%u3u12,idiag_u3u12mz)
        call xysum_mn_name_z(p%u1u23,idiag_u1u23mz)
!
        if (idiag_totalforcezmz/=0) then
          uus = p%rho*(p%fpres(:,3) + p%fvisc(:,3))
          if (lgrav) uus = uus + p%rho*p%gg(:,3)
          call xysum_mn_name_z(uus,idiag_totalforcezmz)
        endif
        if (idiag_totalforcezupmz/=0) then
          where (p%uu(:,3) > 0.) 
            uus = p%rho*(p%fpres(:,3) + p%fvisc(:,3) + p%gg(:,3))
          elsewhere
            uus=0.
          endwhere
          call xysum_mn_name_z(uus,idiag_totalforcezupmz)
        endif
        if (idiag_totalforcezdownmz/=0) then
          where (p%uu(:,3) < 0.)
            uus = p%rho*(p%fpres(:,3) + p%fvisc(:,3) + p%gg(:,3))
          elsewhere
            uus=0.
          endwhere
          call xysum_mn_name_z(uus,idiag_totalforcezdownmz)
        endif
!
        if (idiag_acczmz/=0) then
          uus = p%fpres(:,3) + p%fvisc(:,3)
          if (lgrav) uus = uus + p%gg(:,3)
          call xysum_mn_name_z(uus,idiag_acczmz)   ! yet incorrect for Yin-Yang
        endif
        if (idiag_acczupmz/=0) then
          where (p%uu(:,3) > 0.) 
            uus = p%fpres(:,3) + p%fvisc(:,3) + p%gg(:,3)
          elsewhere
            uus=0.
          endwhere
          call xysum_mn_name_z(uus,idiag_acczupmz)   ! yet incorrect for Yin-Yang
        endif
        if (idiag_acczdownmz/=0) then
          where (p%uu(:,3) < 0.)
            uus = p%fpres(:,3) + p%fvisc(:,3) + p%gg(:,3)
          elsewhere
            uus=0.
          endwhere
          call xysum_mn_name_z(uus,idiag_acczdownmz)   ! yet incorrect for Yin-Yang
        endif
!
        if (idiag_accpowzmz/=0) then
          uus = p%fpres(:,3) + p%fvisc(:,3)
          if (lgrav) uus = uus + p%gg(:,3)
          uus=p%uu(:,3)*uus
          call xysum_mn_name_z(uus,idiag_accpowzmz)   ! yet incorrect for Yin-Yang
        endif
        if (idiag_accpowzupmz/=0) then
          where (p%uu(:,3) > 0.) 
            uus = p%fpres(:,3) + p%fvisc(:,3) + p%gg(:,3)
            uus = p%uu(:,3)*uus
          elsewhere
            uus=0.
          endwhere
          call xysum_mn_name_z(uus,idiag_accpowzupmz)   ! yet incorrect for Yin-Yang
        endif
        if (idiag_accpowzdownmz/=0) then
          where (p%uu(:,3) < 0.)
            uus = p%fpres(:,3) + p%fvisc(:,3) + p%gg(:,3)
            uus = p%uu(:,3)*uus
          elsewhere
            uus=0.
          endwhere
          call xysum_mn_name_z(uus,idiag_accpowzdownmz)   ! yet incorrect for Yin-Yang
        endif
!
!  phi-z averages
!
        if (idiag_Remz/=0) then
          Remz = sqrt(p%ugu2/p%diffus_total**2)
          where (p%diffus_total < tini) Remz = 0.
          call xysum_mn_name_z(Remz,idiag_Remz)
        endif
        if (idiag_u2mr/=0)   call phizsum_mn_name_r(p%u2,idiag_u2mr)
        if (idiag_urmr/=0) &
            call phizsum_mn_name_r(p%uu(:,1)*p%pomx+p%uu(:,2)*p%pomy,idiag_urmr)
        if (idiag_upmr/=0) &
            call phizsum_mn_name_r(p%uu(:,1)*p%phix+p%uu(:,2)*p%phiy,idiag_upmr)
        if (idiag_uzmr/=0) &
             call phizsum_mn_name_r(p%uu(:,3),idiag_uzmr)
        if (idiag_ormr/=0) &
            call phizsum_mn_name_r(p%oo(:,1)*p%pomx+p%oo(:,2)*p%pomy,idiag_ormr)
        if (idiag_opmr/=0) &
            call phizsum_mn_name_r(p%oo(:,1)*p%phix+p%oo(:,2)*p%phiy,idiag_opmr)
        if (idiag_ozmr/=0) &
             call phizsum_mn_name_r(p%oo(:,3),idiag_ozmr)
      endif

    endsubroutine calc_1d_diagnostics_hydro
!******************************************************************************
    subroutine calc_2d_diagnostics_hydro(f,p)
!
!   6-sep-19/MR: taken out from duu_dt
!
      use Diagnostics
      use Sub, only: dot, dot2, cross

      real, dimension(:,:,:,:) :: f
      type(pencil_case), intent(in) :: p
!
      real, dimension (nx) :: uus, uxmask
!
!  2-D averages.
!  Note that this does not necessarily happen with ldiagnos=.true.
!
      if (l2davgfirst) then
        if (idiag_urmphi/=0) &
            call phisum_mn_name_rz(p%uu(:,1)*p%pomx+p%uu(:,2)*p%pomy,idiag_urmphi)
        if (idiag_ur2mphi/=0) &
            call phisum_mn_name_rz((p%uu(:,1)*p%pomx+p%uu(:,2)*p%pomy)**2,idiag_ur2mphi)
        if (idiag_ursphmphi/=0) &
            call phisum_mn_name_rz(p%uu(:,1)*p%evr(:,1)+ &
              p%uu(:,2)*p%evr(:,2)+p%uu(:,3)*p%evr(:,3),idiag_ursphmphi)
        if (idiag_uthmphi/=0) &
            call phisum_mn_name_rz(p%uu(:,1)*p%evth(:,1)+ &
              p%uu(:,2)*p%evth(:,2)+p%uu(:,3)*p%evth(:,3),idiag_uthmphi)
        if (idiag_rursphmphi/=0) &
            call phisum_mn_name_rz(p%rho*(p%uu(:,1)*p%evr(:,1)+ &
              p%uu(:,2)*p%evr(:,2)+p%uu(:,3)*p%evr(:,3)),idiag_rursphmphi)
        if (idiag_ruthmphi/=0) &
            call phisum_mn_name_rz(p%rho*(p%uu(:,1)*p%evth(:,1)+ &
              p%uu(:,2)*p%evth(:,2)+p%uu(:,3)*p%evth(:,3)),idiag_ruthmphi)
        if (idiag_upmphi/=0) &
            call phisum_mn_name_rz(p%uu(:,1)*p%phix+p%uu(:,2)*p%phiy,idiag_upmphi)
        if (idiag_up2mphi/=0) &
            call phisum_mn_name_rz((p%uu(:,1)*p%phix+p%uu(:,2)*p%phiy)**2,idiag_up2mphi)
        call phisum_mn_name_rz(p%uu(:,3),idiag_uzmphi)
        call phisum_mn_name_rz(p%uu(:,3)**2,idiag_uz2mphi)
        call phisum_mn_name_rz(p%u2,idiag_u2mphi)
        if (idiag_urupmphi/=0) &
            call phisum_mn_name_rz((p%uu(:,1)*p%pomx+p%uu(:,2)*p%pomy)*(p%uu(:,1)*p%phix+p%uu(:,2)*p%phiy),idiag_urupmphi)
        if (idiag_uruzmphi/=0) &
            call phisum_mn_name_rz((p%uu(:,1)*p%pomx+p%uu(:,2)*p%pomy)*p%uu(:,3),idiag_uruzmphi)
        if (idiag_upuzmphi/=0) &
            call phisum_mn_name_rz((p%uu(:,1)*p%phix+p%uu(:,2)*p%phiy)*p%uu(:,3),idiag_upuzmphi)
        if (idiag_rurupmphi/=0) &
            call phisum_mn_name_rz(p%rho*(p%uu(:,1)*p%pomx+p%uu(:,2)*p%pomy)*(p%uu(:,1)*p%phix+p%uu(:,2)*p%phiy),idiag_rurupmphi)
        if (idiag_ruruzmphi/=0) &
            call phisum_mn_name_rz(p%rho*(p%uu(:,1)*p%pomx+p%uu(:,2)*p%pomy)*p%uu(:,3),idiag_ruruzmphi)
        if (idiag_rupuzmphi/=0) &
            call phisum_mn_name_rz(p%rho*(p%uu(:,1)*p%phix+p%uu(:,2)*p%phiy)*p%uu(:,3),idiag_rupuzmphi)
        if (idiag_rurmphi/=0) &
            call phisum_mn_name_rz(p%rho*(p%uu(:,1)*p%pomx+p%uu(:,2)*p%pomy),idiag_rurmphi)
        if (idiag_rupmphi/=0) &
            call phisum_mn_name_rz(p%rho*(p%uu(:,1)*p%phix+p%uu(:,2)*p%phiy),idiag_rupmphi)
        if (idiag_rupmphi/=0) &
            call phisum_mn_name_rz(p%rho*p%uu(:,3),idiag_ruzmphi)
        call phisum_mn_name_rz(p%oo(:,3),idiag_ozmphi)
        call phisum_mn_name_rz(p%ou,idiag_oumphi)
        if (idiag_fkinrsphmphi/=0) &
            call phisum_mn_name_rz(p%ekin*(p%uu(:,1)*p%evr(:,1)+ &
              p%uu(:,2)*p%evr(:,2)+p%uu(:,3)*p%evr(:,3)),idiag_fkinrsphmphi)
!
        call ysum_mn_name_xz(p%uu(:,1),idiag_uxmxz)
        call ysum_mn_name_xz(p%uu(:,2),idiag_uymxz)
        call ysum_mn_name_xz(p%uu(:,3),idiag_uzmxz)
        if (idiag_ux2mxz/=0) &
            call ysum_mn_name_xz(p%uu(:,1)**2,idiag_ux2mxz)
        if (idiag_uy2mxz/=0) &
            call ysum_mn_name_xz(p%uu(:,2)**2,idiag_uy2mxz)
        if (idiag_uz2mxz/=0) &
            call ysum_mn_name_xz(p%uu(:,3)**2,idiag_uz2mxz)
        if (idiag_uxuymxz/=0) &
            call ysum_mn_name_xz(p%uu(:,1)*p%uu(:,2),idiag_uxuymxz)
        if (idiag_uxuzmxz/=0) &
            call ysum_mn_name_xz(p%uu(:,1)*p%uu(:,3),idiag_uxuzmxz)
        if (idiag_uyuzmxz/=0) &
            call ysum_mn_name_xz(p%uu(:,2)*p%uu(:,3),idiag_uyuzmxz)
        call ysum_mn_name_xz(p%ou,idiag_oumxz)
!
        call zsum_mn_name_xy(p%uu(:,1),idiag_uxmxy)
!
!  Changed calls for compatibility with Yin-Yang grid:
!  all non-scalars in which y or z components of a vector are used must
!  be treated as below,
!
        call zsum_mn_name_xy(p%uu,idiag_uymxy,(/0,1,0/))
        call zsum_mn_name_xy(p%uu,idiag_uzmxy,(/0,0,1/))
        call zsum_mn_name_xy(p%uu,idiag_uxuymxy,(/1,1,0/))
        call zsum_mn_name_xy(p%uu,idiag_uxuzmxy,(/1,0,1/))
        call zsum_mn_name_xy(p%uu,idiag_uyuzmxy,(/0,1,1/))
        if (idiag_Rxymxy/=0) call zsum_mn_name_xy(f(l1:l2,m,n,iuu_flucx)*f(l1:l2,m,n,iuu_flucy),idiag_Rxymxy)
        if (idiag_Rxzmxy/=0) call zsum_mn_name_xy(f(l1:l2,m,n,iuu_flucx)*f(l1:l2,m,n,iuu_flucz),idiag_Rxzmxy)
        if (idiag_Ryzmxy/=0) call zsum_mn_name_xy(f(l1:l2,m,n,iuu_flucy)*f(l1:l2,m,n,iuu_flucz),idiag_Ryzmxy)
        call zsum_mn_name_xy(p%oo(:,1),idiag_oxmxy)
        call zsum_mn_name_xy(p%oo,idiag_oymxy,(/0,1,0/))
        call zsum_mn_name_xy(p%oo,idiag_ozmxy,(/0,0,1/))
        call zsum_mn_name_xy(p%ou,idiag_oumxy)
        if (idiag_pvzmxy/=0) &
            call zsum_mn_name_xy((p%oo(:,3)+2.*Omega)/p%rho,idiag_pvzmxy)    ! yet incorrect for Yin-Yang
        if (idiag_ruxmxy/=0) call zsum_mn_name_xy(p%rho*p%uu(:,1),idiag_ruxmxy)
        call zsum_mn_name_xy(p%uu,idiag_ruymxy,(/0,1,0/),p%rho)
        call zsum_mn_name_xy(p%uu,idiag_ruzmxy,(/0,0,1/),p%rho)
        if (idiag_ux2mxy/=0) &
            call zsum_mn_name_xy(p%uu(:,1)**2,idiag_ux2mxy)
        call zsum_mn_name_xy(p%uu,idiag_uy2mxy,(/0,2,0/))
        call zsum_mn_name_xy(p%uu,idiag_uz2mxy,(/0,0,2/))
        if (idiag_rux2mxy/=0) &
            call zsum_mn_name_xy(p%rho*p%uu(:,1)**2,idiag_rux2mxy)
        call zsum_mn_name_xy(p%uu,idiag_ruy2mxy,(/0,2,0/),p%rho)
        call zsum_mn_name_xy(p%uu,idiag_ruz2mxy,(/0,0,2/),p%rho)
        call zsum_mn_name_xy(p%uu,idiag_ruxuymxy,(/1,1,0/),p%rho)
        call zsum_mn_name_xy(p%uu,idiag_ruxuzmxy,(/1,0,1/),p%rho)
        call zsum_mn_name_xy(p%uu,idiag_ruyuzmxy,(/0,1,1/),p%rho)
        if (idiag_fkinxmxy/=0) &
            call zsum_mn_name_xy(p%ekin*p%uu(:,1),idiag_fkinxmxy)
        call zsum_mn_name_xy(p%uu,idiag_fkinymxy,(/0,1,0/),p%ekin)
        call zsum_mn_name_xy(p%ugu(:,1),idiag_uguxmxy)
        call zsum_mn_name_xy(p%ugu,idiag_uguymxy,(/0,1,0/))
        call zsum_mn_name_xy(p%ugu,idiag_uguzmxy,(/0,0,1/))
        if (idiag_uxupmxy/=0 .or. idiag_ruxupmxy/=0 .or. idiag_ux2upmxy/=0 .or. &
            idiag_fkinxupmxy/=0 .or. idiag_Rxyupmxy/=0 .or. idiag_Rxzupmxy/=0 .or. &
            idiag_Ryzupmxy/=0) then
          where (p%uu(:,1) > 0.)
            uus = p%uu(:,1)
            uxmask = p%uu(:,1)/abs(p%uu(:,1))
          elsewhere
            uus=0.
            uxmask = 0.
          endwhere
          call zsum_mn_name_xy(uus,idiag_uxupmxy)
          if (idiag_ruxupmxy/=0) call zsum_mn_name_xy(p%rho*uus,idiag_ruxupmxy)
          if (idiag_ux2upmxy/=0) call zsum_mn_name_xy(uus**2,idiag_ux2upmxy)
          if (idiag_fkinxupmxy/=0) call zsum_mn_name_xy(p%ekin*uus,idiag_fkinxupmxy)
          if (idiag_Rxyupmxy/=0) call &
              zsum_mn_name_xy(uxmask*f(l1:l2,m,n,iuu_flucx)*f(l1:l2,m,n,iuu_flucy),idiag_Rxyupmxy)
          if (idiag_Rxzupmxy/=0) call &
              zsum_mn_name_xy(uxmask*f(l1:l2,m,n,iuu_flucx)*f(l1:l2,m,n,iuu_flucz),idiag_Rxzupmxy)
          if (idiag_Ryzupmxy/=0) call &
              zsum_mn_name_xy(uxmask*f(l1:l2,m,n,iuu_flucy)*f(l1:l2,m,n,iuu_flucz),idiag_Ryzupmxy)
        endif
        if (idiag_ffdownmxy/=0  .or. idiag_uxdownmxy/=0 .or. idiag_ruxdownmxy/=0 .or. &
            idiag_ux2downmxy/=0 .or. idiag_fkinxdownmxy/=0 .or. idiag_Rxydownmxy/=0 .or. &
            idiag_Rxzdownmxy/=0 .or. idiag_Ryzdownmxy/=0) then
          where (p%uu(:,1) < 0.)
            uus = p%uu(:,1)
            uxmask = -p%uu(:,1)/abs(p%uu(:,1))
          elsewhere
            uus = 0.
            uxmask = 0.
          endwhere
          if (idiag_ffdownmxy/=0) call zsum_mn_name_xy(-uus/abs(p%uu(:,1)),idiag_ffdownmxy)
          Call zsum_mn_name_xy(uus,idiag_uxdownmxy)
          if (idiag_ruxdownmxy/=0) call zsum_mn_name_xy(p%rho*uus,idiag_ruxdownmxy)
          if (idiag_ux2downmxy/=0) call zsum_mn_name_xy(uus**2,idiag_ux2downmxy)
          if (idiag_fkinxdownmxy/=0) call zsum_mn_name_xy(p%ekin*uus,idiag_fkinxdownmxy)
          if (idiag_Rxydownmxy/=0) call &
              zsum_mn_name_xy(uxmask*f(l1:l2,m,n,iuu_flucx)*f(l1:l2,m,n,iuu_flucy),idiag_Rxydownmxy)
          if (idiag_Rxzdownmxy/=0) call &
              zsum_mn_name_xy(uxmask*f(l1:l2,m,n,iuu_flucx)*f(l1:l2,m,n,iuu_flucz),idiag_Rxzdownmxy)
          if (idiag_Ryzdownmxy/=0) call &
              zsum_mn_name_xy(uxmask*f(l1:l2,m,n,iuu_flucy)*f(l1:l2,m,n,iuu_flucz),idiag_Ryzdownmxy)
        endif
      else
!
!  idiag_uxmxy and idiag_uymxy also need to be calculated when
!  ldiagnos and idiag_umx and/or idiag_umy, so
!
!  We may need to calculate uxmxy without calculating umx. The following
!  if condition was messing up calculation of umxy_rms
!
        if (ldiagnos) then
          call zsum_mn_name_xy(p%uu(:,1),idiag_uxmxy)
          call zsum_mn_name_xy(p%uu,idiag_uymxy,(/0,1,0/))
          call zsum_mn_name_xy(p%uu,idiag_uzmxy,(/0,0,1/))
        endif
      endif

    endsubroutine calc_2d_diagnostics_hydro
!**************************************************************************************
    subroutine calc_diagnostics_hydro(f,p)

      use Slices_methods, only: store_slices
      use Sub, only: vecout

      real, dimension(:,:,:,:) :: f
      type(pencil_case), intent(in) :: p

      call calc_2d_diagnostics_hydro(f,p)
      call calc_1d_diagnostics_hydro(f,p)
      call calc_0d_diagnostics_hydro(f,p)
!
!  store slices for output in wvid in run.f90
!  This must be done outside the diagnostics loop (accessed at different times).
!
      if (lvideo.and.lfirst) then
        if (ivid_divu/=0) call store_slices(p%divu,divu_xy,divu_xz,divu_yz,divu_xy2,divu_xy3,divu_xy4,divu_xz2,divu_r)
        if (ivid_oo  /=0) call store_slices(p%oo,oo_xy,oo_xz,oo_yz,oo_xy2,oo_xy3,oo_xy4,oo_xz2,oo_r)
        if (ivid_u2  /=0) call store_slices(p%u2,u2_xy,u2_xz,u2_yz,u2_xy2,u2_xy3,u2_xy4,u2_xz2,u2_r)
        if (ivid_o2  /=0) call store_slices(p%o2,o2_xy,o2_xz,o2_yz,o2_xy2,o2_xy3,o2_xy4,o2_xz2,o2_r)
        if (ivid_ou  /=0) call store_slices(p%ou,ou_xy,ou_xz,ou_yz,ou_xy2,ou_xy3,ou_xy4,ou_xz2,ou_r)
        if (ivid_Ma2 /=0) call store_slices(p%Ma2,mach_xy,mach_xz,mach_yz,mach_xy2,mach_xy3,mach_xy4,mach_xz2,mach_r)
        if (ivid_uu_sph/=0) call store_slices(p%uu_sph,uu_sph_xy,uu_sph_xz,uu_sph_yz,uu_sph_xy2, &
                                                       uu_sph_xy3,uu_sph_xy4,uu_sph_xz2,uu_sph_r)
        if (othresh_per_orms/=0) then
          call calc_othresh
          call vecout(41,trim(directory)//'/ovec',p%oo,othresh,novec)
        endif
      endif

    endsubroutine calc_diagnostics_hydro
!******************************************************************************
    subroutine df_diagnos_hydro(df,p)

      use Diagnostics, only: sum_mn_name

      type(pencil_case), intent(in) :: p
      real, dimension(:,:,:,:) :: df

      real, dimension (nx) :: uduu
      integer :: i

      if (idiag_uduum/=0) then
        uduu=0.
        do i = 1,3
          uduu=uduu+p%uu(:,i)*df(l1:l2,m,n,iux-1+i)
        enddo
        call sum_mn_name(p%rho*uduu,idiag_uduum)
      endif

    endsubroutine df_diagnos_hydro
!******************************************************************************
    subroutine time_integrals_hydro(f,p)
!
!  Calculate time_integrals within each pencil (as long as each
!  pencil case p still contains the current data). This routine
!  is now being called at the end of equ.
!
!  28-jun-07/axel+mreinhard: coded
!  24-jun-08/axel: moved call to this routine to the individual pde routines
!   1-jul-08/axel: moved this part to hydro
!  29-oct-20/hongzhe: coding for computing frequency-fft'ed u(x,y,z,omega_fourier)
!  19-may-21/axel: possibility of ltime_integrals_always=F to compute <u(t,x).u(t0,x)>
!  11-dec-21/hongzhe: uut and oot are now always in lab frame, but their update time
!                     is write to file for future shear-frame transformation.
!
      use SharedVariables, only: put_shared_variable
!
      real, dimension (mx,my,mz,mfarray) :: f
      type (pencil_case) :: p
!
      intent(inout) :: f
      intent(in) :: p
!
      real :: fact_cos,fact_sin,t_cor=0.
      logical :: lreset_vart=.false.
!
      fact_cos=cos(omega_fourier*t)
      fact_sin=sin(omega_fourier*t)
!
!  reset uut etc. if lreset_vart=.true.
!
      if (ltime_integrals_always .or. dtcor<=0.) then
        if (it==1) lreset_vart=.true.
      else
        if (t>t_vart) then
          lreset_vart=.true.
          t_cor=t
          call put_shared_variable('t_cor',t_cor,caller='time_integrals_hydro')
!
!  If uut and oot are updated, write t to file and advance t_var.
!  These only happen at the last point in the mn loop.
!
          if (llastpoint) then
            if (lroot) then
              open(1,file=trim(datadir)//'/tvart.dat',status='unknown',position='append')
              write(1,'(4f14.7)') t_cor
              close (1)
            endif
            t_vart=t_vart+dtcor
          endif
        endif
      endif
!
!  assign values to uut etc.
!
      if (ltime_integrals_always) then
        if (lreset_vart) then
          if (iuut/=0)  f(l1:l2,m,n,iuxt:iuzt)  =0.
          if (iuust/=0) f(l1:l2,m,n,iuxst:iuzst)=0.
          if (ioot/=0)  f(l1:l2,m,n,ioxt:iozt)  =0.
          if (ioost/=0) f(l1:l2,m,n,ioxst:iozst)=0.
        else
          if (iuut/=0)  f(l1:l2,m,n,iuxt:iuzt)  =f(l1:l2,m,n,iuxt:iuzt)  +dt*p%uu*fact_cos
          if (iuust/=0) f(l1:l2,m,n,iuxst:iuzst)=f(l1:l2,m,n,iuxst:iuzst)+dt*p%uu*fact_sin
          if (ioot/=0)  f(l1:l2,m,n,ioxt:iozt)  =f(l1:l2,m,n,ioxt:iozt)  +dt*p%oo*fact_cos
          if (ioost/=0) f(l1:l2,m,n,ioxst:iozst)=f(l1:l2,m,n,ioxst:iozst)+dt*p%oo*fact_sin
        endif
      else
        if (iuust/=0) f(l1:l2,m,n,iuxst:iuzst)=0.
        if (ioost/=0) f(l1:l2,m,n,ioxst:iozst)=0.
        if (lreset_vart) then
          if (lvart_in_shear_frame) &
              call fatal_error('time_integrals_hydro',&
                  'lvart_in_shear_frame is no longer supported in hydro. uut etc. are always &
                   &in lab frame. lshear_frame_correlation=T now transforms both uu and uut.')
          if (iuxt/=0)              f(l1:l2,m,n,iuxt:iuzt)  =f(l1:l2,m,n,iux:iuz)
          if (ioxt/=0 .and. iox/=0) f(l1:l2,m,n,ioxt:iozt)  =f(l1:l2,m,n,iox:ioz)
        endif
      endif
      lreset_vart=.false.
!
    endsubroutine time_integrals_hydro
!***********************************************************************
    subroutine hydro_after_boundary(f)
!
!  Calculate <rho*ux> and <rho*uy> when tau_damp_ruxm, tau_damp_ruym,
!  or tau_damp_ruzm are different from zero. Was used to remove net
!  momenta in any of the three directions. A better method is now
!  to set lremove_mean_momenta=T in the call to remove_mean_momenta.
!  Calculates <U>, when lcalc_uumean=.true.
!
!   9-nov-06/axel: adapted from calc_ltestfield_pars
!  31-jul-08/axel: Poincare force with O=(sinalp*cosot,sinalp*sinot,cosalp)
!  12-sep-13/MR  : use finalize_aver
!
      use Sub, only: finalize_aver
      use Magnetic, only: calc_pencils_magnetic

      real, dimension (mx,my,mz,mfarray) :: f
      intent(inout) :: f

      real, dimension (3,3) :: mat_cent1=0.,mat_cent2=0.,mat_cent3=0.
      real, dimension (3) :: OO, dOO, uum0
      real :: c,s,sinalp,cosalp,OO2,alpha_precession_rad
      integer :: i,j,l
!
!  possibility of setting interior boundary conditions
!
      if (lhydro_bc_interior) call interior_bc_hydro(f)
!
      call calc_means_hydro(f)
!
!  calculate precession matrices, assume that alpha_precession is given
!  in degrees.
!
      if (lprecession) then
        c=cos(omega_precession*t)
        s=sin(omega_precession*t)
        alpha_precession_rad=alpha_precession
        cosalp=cos(alpha_precession_rad)
        sinalp=sin(alpha_precession_rad)
!
!  Components of Omega vector
!
        OO(1)=Omega*sinalp*c
        OO(2)=Omega*sinalp*s
        OO(3)=Omega*cosalp
!
!  Components of time derivative of Omega vector
!
        dOO(1)=-Omega*sinalp*s
        dOO(2)=+Omega*sinalp*c
        dOO(3)=0.
!
!  Coriolis matrix
!
        mat_cori(1,2)=+2.*OO(3); mat_cori(2,1)=-2.*OO(3)
        mat_cori(2,3)=+2.*OO(1); mat_cori(3,2)=-2.*OO(1)
        mat_cori(3,1)=+2.*OO(2); mat_cori(1,3)=-2.*OO(2)
!
!  1st centrifugal matrix
!
        do i=1,3
        do j=1,3
          mat_cent1(i,j)=-OO(i)*OO(j)
        enddo
        enddo
!
!  2nd centrifugal matrix
!
        OO2=OO(1)+OO(2)+OO(3)
        do j=1,3
          mat_cent2(j,j)=OO2
        enddo
!
!  3rd centrifugal matrix
!
        mat_cent3(1,2)=+dOO(3); mat_cent3(2,1)=-dOO(3)
        mat_cent3(2,3)=+dOO(1); mat_cent3(3,2)=-dOO(1)
        mat_cent3(3,1)=+dOO(2); mat_cent3(1,3)=-dOO(2)
!
!  adding the three centrifugal matrixes together
!
        mat_cent=mat_cent1+mat_cent2+mat_cent3
      endif
!
!  calculate precession matrices
!
!     if (lprecession) then
!       c=cos(omega_precession*t)
!       s=sin(omega_precession*t)
!       mat_cori1(2,3)=+1.
!       mat_cori1(3,2)=-1.
!
!
!       mat_cori2(1,2)=+c
!       mat_cori2(1,3)=-s
!       mat_cori2(2,1)=-c
!       mat_cori2(3,1)=+s
!       mat_cent1(2,2)=+1.
!       mat_cent1(3,3)=+1.
!       mat_cent2(1,1)=+1.
!       mat_cent2(2,2)=+c**2
!       mat_cent2(3,3)=+s**2
!       mat_cent2(2,3)=-2.*s*c
!       mat_cent2(3,2)=-2.*s*c
!       mat_cent3(1,2)=-s+c
!       mat_cent3(2,1)=-s-c
!       mat_cent3(1,3)=-s-c
!       mat_cent3(3,1)=+s-c
!       mat_cori=2.*(omega_precession*mat_cori1+Omega*mat_cori2)
!       mat_cent=omega_precession**2*mat_cent1+Omega**2*mat_cent2 &
!         +2.*omega_precession*Omega*mat_cent3
!     endif
!
!
!  Remove mean flow (z average).
!
      if (lrmv) then
        if (lremove_uumeanxy) then
!
          do j=1,3
            do n=1,mz
              f(:,:,n,iuu+j-1) = f(:,:,n,iuu+j-1)-uumxy(:,:,j)
            enddo
          enddo
        endif
!
!  Do z-averaging for Schur flows
!
        if (lSchur_2D2D3D_uu) then
          do j=1,2
            do n=1,mz
              f(:,:,n,iuu+j-1) = uumxy(:,:,j)
            enddo
          enddo
        endif
!
!  Remove mean flow (xy average).
!
        if (lremove_uumeanz) then
          do j=1,3
            do n=1,mz
              f(:,:,n,iuu+j-1) = f(:,:,n,iuu+j-1)-uumz(n,j)
            enddo
          enddo
        elseif (lremove_uumeanz_horizontal) then
!
!  Remove only xy-averaged horizontal flows
!
          do j=1,2
            do n=1,mz
              f(:,:,n,iuu+j-1) = f(:,:,n,iuu+j-1)-uumz(n,j)
            enddo
          enddo
        endif
!
!  Do xy-averaging for Schur flows
!
        if (lSchur_3D3D1D_uu) then
          do n=1,mz
            f(:,:,n,iuu+2) = uumz(n,3)
          enddo
        endif
!
!  Remove mean flow (xz average).
!
        if (lremove_uumeany) then
!
!  uum0 is formed to avoid double substraction of <uu>_xyz.
!
          if (lremove_uumeanz.or.lremove_uumeanz_horizontal) then
            uum0=sum(uumy(m1:m2,:),1)/nygrid
            call finalize_aver(nprocy,2,uum0)
            if (lremove_uumeanz_horizontal) uum0(3)=0.
          endif

          do j=1,3
            do m=1,my
              f(:,m,:,iuu+j-1) = f(:,m,:,iuu+j-1)-uumy(m,j)
            enddo 
            if (lremove_uumeanz.or.lremove_uumeanz_horizontal) &
              f(:,:,:,iuu+j-1)=f(:,:,:,iuu+j-1)+uum0(j)  ! compensation as uum0 is already substracted once
          enddo

        endif
!
!  Remove mean flow (yz average).
!
        if (lremove_uumeanx) then
!
!  uum0 is formed to avoid double substraction of <uu>_xyz.
!
          if (lremove_uumeanz.or.lremove_uumeanz_horizontal.or.lremove_uumeany) then
            uum0=sum(uumx(l1:l2,:),1)/nxgrid
            call finalize_aver(nprocx,1,uum0)
            if (lremove_uumeanz_horizontal) uum0(3)=0.
          endif

          do j=1,3
            do l=1,mx
              f(l,:,:,iuu+j-1) = f(l,:,:,iuu+j-1)-uumx(l,j)
            enddo
            if (lremove_uumeanz.or.lremove_uumeanz_horizontal.or.lremove_uumeany) &
              f(:,:,:,iuu+j-1)=f(:,:,:,iuu+j-1)+uum0(j)  ! compensation as uum0 is already substracted once
          enddo
        endif
      endif
!
!  Compute fluctuating velocity and put in an auxilliary array
!
      if (luu_fluc_as_aux) then
        if (lcalc_uumeanz) then
          do j=1,3
            do n=1,mz
              f(l1:l2,m1:m2,n,iuu_fluc+j-1) = f(l1:l2,m1:m2,n,iuu+j-1) - uumz(n,j)
            enddo
          enddo
        endif
!
        if (lcalc_uumeanxy) then
          do j=1,3
            do n=1,mz
              f(l1:l2,m1:m2,n,iuu_fluc+j-1) = f(l1:l2,m1:m2,n,iuu+j-1) - uumxy(l1:l2,m1:m2,j)
            enddo
          enddo
        endif
      endif

      if (lSGS_hydro) call SGS_hydro_after_boundary(f)
!
    endsubroutine hydro_after_boundary
!***********************************************************************
    subroutine set_border_hydro(f,df,p)
!
!  Calculates the driving term for the border profile
!  of the uu variable.
!
!  28-jul-06/wlad: coded
!
      use BorderProfiles,  only: border_driving,set_border_initcond
!
      real, dimension (mx,my,mz,mfarray) :: f
      type (pencil_case) :: p
      real, dimension (mx,my,mz,mvar) :: df
      real, dimension (nx,3) :: f_target
      integer :: j,ju
!
      do j=1,3

        select case (borderuu(j))
!
        case ('zero','0')
          f_target(:,j)=0.
!
        case ('constant')
          f_target(:,j) = uu_const(j)
!
        case ('initial-condition')
          ju=j+iuu-1
          call set_border_initcond(f,ju,f_target(:,j))
!
        case ('nothing')
          if (lroot.and.ip<=5) &
               print*,"set_border_hydro: borderuu='nothing'"
!
        case default
          write(unit=errormsg,fmt=*) &
               'set_border_hydro: No such value for borderuu: ', &
               trim(borderuu(j))
          call fatal_error('set_border_hydro',errormsg)
!
        endselect

        if (borderuu(j)/='nothing') then
          ju=j+iuu-1
          call border_driving(f,df,p,f_target(:,j),ju)
        endif
!
      enddo
!
    endsubroutine set_border_hydro
!***********************************************************************
    subroutine calc_othresh
!
!  calculate othresh from orms, give warnings if there are problems
!
!  24-nov-03/axel: adapted from calc_bthresh
!
!  if nvec exceeds novecmax (=1/4) of points per processor, then begin to
!  increase scaling factor on othresh. These settings will stay in place
!  until the next restart
!
      if (novec>novecmax.and.lfirstpoint) then
        print*,'calc_othresh: processor ',iproc_world,': othresh_scl,novec,novecmax=', &
                                          othresh_scl,novec,novecmax
        othresh_scl=othresh_scl*1.2
      endif
!
!  calculate othresh as a certain fraction of orms
!
      othresh=othresh_scl*othresh_per_orms*orms  !!!MR: orms not yet valid when used inside duu_dt
!
    endsubroutine calc_othresh
!***********************************************************************
    subroutine precession(df,p)
!
!  precession terms
!
!  19-jan-07/axel: added terms derived by Gailitis
!
      real, dimension (mx,my,mz,mvar) :: df
      type (pencil_case) :: p
!
      integer :: i,j,k
!
!  info about precession term
!
      if (headtt) then
        print*, 'precession: omega_precession=', omega_precession
      endif
!
!  matrix multiply
!
      do j=1,3
      do i=1,3
        k=iuu-1+i
        df(l1:l2,m,n,k)=df(l1:l2,m,n,k) &
          +mat_cent(i,j)*p%rr(:,j) &
          +mat_cori(i,j)*p%uu(:,j)
      enddo
      enddo
!
    endsubroutine precession
!***********************************************************************
   subroutine coriolis_cartesian(df,uu,velind)
!
!  Coriolis terms for Cartesian geometry.
!
!  30-oct-09/MR: outsourced, parameter velind added
!  15-feb-15/MR: calculation of Coriolis force of shear flow added
!
      real, dimension (mx,my,mz,mvar), intent(inout) :: df
      real, dimension (nx,3),          intent(in)  :: uu
      integer,                         intent(in)  :: velind
!
!  velind is start index for velocity variable to which Coriolis force
!  corresponds
!  x,y,z components are referred to by velind, velind+1, velind+2
!
      real :: c2, s2
!
      if (Omega==0.) return
!
      if (theta==0) then
!
        if (lcoriolis_force) then
!
          if (headtt) print*,'coriolis_cartesian: add Coriolis force; Omega=',Omega
!
          c2=2*Omega
          df(l1:l2,m,n,velind  )=df(l1:l2,m,n,velind  )+c2*uu(:,2)
          df(l1:l2,m,n,velind+1)=df(l1:l2,m,n,velind+1)-c2*uu(:,1)
!
        endif
!
!  Add centrifugal force (doing this with periodic boundary
!  conditions in x and y would not be compatible, so it is
!  therefore usually ignored in those cases!)
!
        if (lcentrifugal_force) then
!
          if (headtt) print*,'coriolis_cartesian: add Centrifugal force; Omega=',Omega
          if (headtt) print*,'coriolis_cartesian: Centrifugal force amplitude; amp_centforce=',amp_centforce
!
          df(l1:l2,m,n,velind  )=df(l1:l2,m,n,velind  )+x(l1:l2)*amp_centforce*Omega**2
          df(l1:l2,m,n,velind+1)=df(l1:l2,m,n,velind+1)+y(  m  )*amp_centforce*Omega**2
!
        endif
!
      else

        if (phi/=0.) &
          call fatal_error("coriolis_cartesian:","not coded if Omega has a y component")
!
!  Add Coriolis force with an angle (defined such that theta=60,
!  for example, would correspond to 30 degrees latitude).
!  Omega=(-sin(theta), 0, cos(theta)).
!
        if (lcoriolis_force) then
!
          if (headtt) &
              print*,'coriolis_cartesian: Coriolis force; Omega, theta=', Omega, theta
!
!  Note the minus sign in front of the sin_theta term!
!
          c2= 2*Omega*cos(theta*pi/180.)
          s2=-2*Omega*sin(theta*pi/180.)
!
          df(l1:l2,m,n,velind  )=df(l1:l2,m,n,velind  )+c2*uu(:,2)
          df(l1:l2,m,n,velind+1)=df(l1:l2,m,n,velind+1)-c2*uu(:,1)+s2*uu(:,3)
          df(l1:l2,m,n,velind+2)=df(l1:l2,m,n,velind+2)           -s2*uu(:,2)
!
!  Add -2 \Omega \times U^shear, if requested.
!
          if (lshear_in_coriolis) then
            df(l1:l2,m,n,velind  )=df(l1:l2,m,n,velind  )+c2*Sshear*x(l1:l2)
            df(l1:l2,m,n,velind+2)=df(l1:l2,m,n,velind+2)-s2*Sshear*x(l1:l2)
          endif
        endif
!
      endif
!
   endsubroutine coriolis_cartesian
!***********************************************************************
   subroutine coriolis_cartesian_xaxis(df,uu,velind)
!
!  Coriolis force for a box where the rotation axis is in the x-direction
!  In this case the axis of the box represent to x=r, y=theta and  z=phi,
!  so that the z-averages in spherical coordinates corresponds to averages
!  in the phi direction in cartesian coordinates too.
!
!  Adapted from coriolis_cartesian.
!
!  09-aug-10/GG:
!
      real, dimension (mx,my,mz,mvar), intent(inout) :: df
      real, dimension (nx,3),          intent(in)  :: uu
      integer,                         intent(in)  :: velind
!
      real :: c2, s2
!
      if (Omega==0.) return
!
      if (lcoriolis_force) then
!
        if (headtt) &
          print*,'coriolis_cartesian_xaxis: Coriolis force; Omega, theta=', Omega, theta
!
        c2= 2*Omega*cos(theta*pi/180.)
        s2=-2*Omega*sin(theta*pi/180.)
!
        df(l1:l2,m,n,velind  )=df(l1:l2,m,n,velind  )-s2*uu(:,3)
        df(l1:l2,m,n,velind+1)=df(l1:l2,m,n,velind+1)+c2*uu(:,3)
        df(l1:l2,m,n,velind+2)=df(l1:l2,m,n,velind+2)-c2*uu(:,2)+s2*uu(:,1)
!
      endif
!
   endsubroutine coriolis_cartesian_xaxis
!***********************************************************************
   subroutine coriolis_spherical(df,p)
!
!  coriolis_spherical terms using spherical polars
!
!  21-feb-07/axel+dhruba: coded
!  22-dec-15/MR: extended for situation with Omega along y axis (relevant for Yin-Yang grid).
!
      real, dimension (mx,my,mz,mvar) :: df
      type (pencil_case) :: p
      real :: c2,s2,Om2,cp2,cs2,ss2
!
      intent(in) :: p
      intent(inout) :: df
!
!  info about coriolis_spherical term
!
      if (headtt) print*, 'coriolis_spherical: Omega=', Omega
!
! Not yet coded for angular velocity at an angle with z or y axis.
!
      if (.not.(theta==.0.or.theta==90..and.phi==90.)) then
        if (lroot) print*, 'coriolis_spherical: Omega,theta,phi=', Omega,theta, phi
        call fatal_error("coriolis_spherical:","not coded if Omega isn't aligned with z or y axis")
      endif

      if (lcoriolis_force) then
        c2= 2*Omega*costh(m)
        s2=-2*Omega*sinth(m)
      endif

      if (theta==.0) then
!
!  Omega along z axis: In (r,theta,phi) coords, we have \vec{Omega}=Omega*(costh, -sinth, 0). Thus,
!
!                                ( costh)   (u1)           (+sinth*u3)
!  -2*\vec{Omega} x U = -2*Omega*(-sinth) X (u2) = 2*Omega*(+costh*u3)
!                                (   0  )   (u3)           (-costh*u2-sinth*u1)
!
!  With c2=2*Omega*costh and s2=-2*Omega*sinth we have then
!
!                       (-s2*u3)
!  -2*\vec{Omega} x U = (+c2*u3)
!                       (-c2*u2+s2*u1)
!
        if (lcoriolis_force) then
          if (r_omega /= 0.) then
            df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)- s2*p%uu(:,3)              *prof_om
            df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)+ c2*p%uu(:,3)              *prof_om
            df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-(c2*p%uu(:,2)-s2*p%uu(:,1))*prof_om
          else
            df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)-s2*p%uu(:,3)
            df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)+c2*p%uu(:,3)
            df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-c2*p%uu(:,2)+s2*p%uu(:,1)
          endif
        endif
      else
!
!  Omega along y axis: In (r,theta,phi) coords, we have \vec{Omega}=Omega*(sinth*sinph, costh*sinph, cosph). Thus,
!
!                                (sinth*sinph)   (u1)           (-costh*sinph*u3+cosph*      u2)   (-cs2*u3 + cp2*u2)
!  -2*\vec{Omega} x U = -2*Omega*(costh*sinph) X (u2) = 2*Omega*(-cosph*      u1+sinth*sinph*u3) = (-cp2*u1 - ss2*u3)
!                                (      cosph)   (u3)           (-sinth*sinph*u2+costh*sinph*u1)   ( ss2*u2 + cs2*u1)

        cp2=2*Omega*cosph(n); cs2=c2*sinph(n); ss2=s2*sinph(n)

        if (lcoriolis_force) then
          if (r_omega /= 0.) then
            df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)+(-cs2*p%uu(:,3) + cp2*p%uu(:,2))*prof_om
            df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)+(-cp2*p%uu(:,1) - ss2*p%uu(:,3))*prof_om
            df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)+(+ss2*p%uu(:,2) + cs2*p%uu(:,1))*prof_om
          else
            df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux) - cs2*p%uu(:,3) + cp2*p%uu(:,2)
            df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy) - cp2*p%uu(:,1) - ss2*p%uu(:,3)
            df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz) + ss2*p%uu(:,2) + cs2*p%uu(:,1)
          endif
        endif
      endif
!
!  Centrifugal force
!  The term added is F_{centrifugal} = - \Omega X \Omega X r
!
      if (lcentrifugal_force) then

        Om2=amp_centforce*Omega**2
        if (theta==.0) then
          df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)-Om2*x(l1:l2)*sinth(m)
        else
          call fatal_error("coriolis_spherical:","Centrifugal force not coded if Omega isn't aligned with z axis.")
        endif

      endif
!
    endsubroutine coriolis_spherical
!***********************************************************************
    subroutine coriolis_spherical_del2p(f,p)
!
!  coriolis_spherical terms using spherical polars
!
!  21-feb-07/axel+dhruba: coded
!
      real, dimension (mx,my,mz,mfarray) :: f
      type (pencil_case) :: p
!
!  info about coriolis_spherical term
!
      if (headtt) print*, 'coriolis_spherical: Omega=', Omega
!
! Not yet coded for angular velocity at an angle with the z axis.
!
      if (theta/=0) then
        print*, 'coriolis_spherical: Omega=,theta=', Omega,theta
        call fatal_error("coriolis_spherical:","not coded if Omega is at an angle with the z axis. ")
      endif
!
!  In (r,theta,phi) coords, we have Omega=(costh, -sinth, 0). Thus,
!
!                    ( costh)   (u1)      (+sinth*u3)
!  -2*Omega x U = -2*(-sinth) X (u2) = 2*(+costh*u3)
!                    (   0  )   (u3)      (-costh*u2-sinth*u1)
!
!  With c2=2*Omega*costh and s2=-2*Omega*sinth we have then
!
!                (-s2*u3)
!  -2*Omega x U = (+c2*u3)
!                (-c2*u2+s2*u1)
!
!
!  Centrifugal force
!
      if (lcentrifugal_force) &
          call fatal_error("coriolis_spherical_del2p","Centrifugal force not "//&
          "implemented in spherical coordinates")
!
      call keep_compiler_quiet(f)
      call keep_compiler_quiet(p)
!
    endsubroutine coriolis_spherical_del2p
!***********************************************************************
    subroutine coriolis_cylindrical(df,p)
!
!  Coriolis terms using cylindrical coords
!  The formulation is the same as in cartesian, but it is better to
!  keep it here because precession is not implemented for
!  cylindrical coordinates.
!
!  19-sep-07/steveb: coded
!
      real, dimension (mx,my,mz,mvar) :: df
      type (pencil_case) :: p
      real :: c2, s2
!
!  info about coriolis_cylindrical term
!
      if (headtt) &
          print*, 'coriolis_cylindrical: Omega=', Omega
!
! Not yet coded for angular velocity at an angle with the z axis.
!
      if (theta/=0) then
         print*, 'coriolis_cylindrical: Omega=,theta=', Omega,theta
         call fatal_error("coriolis_cylindrical:","not coded if the angular velocity is at an angle to the z axis. ")
      endif
!
!  -2 Omega x u
!
      if (lcoriolis_force) then
        if (lOmega_cyl_xy) then
          c2= 2*Omega*cos(y(m))
          s2=-2*Omega*sin(y(m))
          df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)-c2*p%uu(:,3)
          df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-s2*p%uu(:,3)
          df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)+c2*p%uu(:,1)+s2*p%uu(:,2)
        else
          c2=2*Omega
          df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)+c2*p%uu(:,2)
          df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-c2*p%uu(:,1)
        endif
      endif
!
!  Centrifugal force
!
      if (lcentrifugal_force) &
          df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)+x(l1:l2)*Omega**2
!
!  Note, there is no z-component
!
    endsubroutine coriolis_cylindrical
!***********************************************************************
    subroutine coriolis_cylindrical_del2p(f,p)
!
!  Coriolis terms using cylindrical coords
!  The formulation is the same as in cartesian, but it is better to
!  keep it here because precession is not implemented for
!  cylindrical coordinates.
!
!  19-sep-07/steveb: coded
!
      real, dimension (mx,my,mz,mfarray) :: f
      type (pencil_case) :: p
!
!  info about coriolis_cylindrical term
!
      if (headtt) &
          print*, 'coriolis_cylindrical: Omega=', Omega
!
! Not yet coded for angular velocity at an angle with the z axis.
!
      if (theta/=0) then
         print*, 'coriolis_cylindrical: Omega=,theta=', Omega,theta
         call fatal_error("coriolis_cylindrical:","not coded if the angular velocity is at an angle to the z axis. ")
      endif
!
      call keep_compiler_quiet(f)
      call keep_compiler_quiet(p)
!
    endsubroutine coriolis_cylindrical_del2p
!***********************************************************************
    subroutine coriolis_xdep(df,p)
!
!  Coriolis terms in Cartesian coordinates with Omega depending
!  on x, i.e. Omega=Omega0*(-sin(k_x*x),0,cos(l_x*x)) with k_x=2pi/Lx.
!
!  28-may-09/PJK: coded
!
      real, dimension (mx,my,mz,mvar) :: df
      type (pencil_case) :: p
      real, dimension (nx) :: c1, c2
!
!  info about coriolis_cylindrical term
!
      if (headtt) &
          print*, 'coriolis_xdep: ampl_Omega=', ampl_Omega
!
!  -2 Omega x u
!
      c1=-2*ampl_Omega*sin(pi*((x(l1:l2))-x0)/Lx)
      c2= 2*ampl_Omega*cos(pi*((x(l1:l2))-x0)/Lx)
      df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)             +c2*p%uu(:,2)
      df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)+c1*p%uu(:,3)-c2*p%uu(:,1)
      df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-c1*p%uu(:,2)
!
!  Centrifugal force not coded yet
!
    endsubroutine coriolis_xdep
!***********************************************************************
    subroutine udamping(f,df,p)
!
!  damping terms (artificial, but sometimes useful):
!
!  20-nov-04/axel: added cylindrical Couette flow
!
      use Diagnostics, only: sum_mn_name
      use Sub, only: step
!
      real, dimension (mx,my,mz,mfarray) :: f
      real, dimension (mx,my,mz,mvar) :: df
      type (pencil_case) :: p
!
      real, dimension (nx) :: pdamp,fint_work,fext_work
      real, dimension (nx,3) :: fint,fext
      real, save :: tau, fade_fact, last_t = -1.0
      integer :: i,j
!
!  warn about the damping term
!
        if (headtt .and. (dampu /= 0.) .and. (t < tdamp)) then
          if (ldamp_fade) then
            print*, 'udamping: Damping velocities until time ', tdamp
            print*, 'udamping: with a smooth fade starting at ', tfade_start
          else
            print*, 'udamping: Damping velocities constantly until time ', tdamp
          endif
        endif
!
!  1. damp motion during time interval 0<t<tdamp.
!  Damping coefficient is dampu (if >0) or |dampu|/dt (if dampu <0).
!  With ldamp_fade=T, damping coefficient is smoothly fading out
!
!
        if ((dampu /= 0.) .and. (t < tdamp)) then
!
          if (.not. ldamp_fade) then
            ! no fading => full damping:
            fade_fact = 1.
          elseif (t <= tfade_start) then
            ! before transition => full damping:
            fade_fact = 1.
          else
            ! inside transition => smooth fading:
            if (last_t /= t) then
              last_t = t
!
!  smoothly fade out damping according to the following
!  function of time:
!
!    ^
!    |
!  1 +**************
!    |              ****
!    |                  **
!    |                    *
!    |                     **
!    |                       ****
!  0 +-------------+-------------**********---> t
!    |             |             |
!    0            Tfade_start   Tdamp
!
!  For 0 < t < Tfade_start, full damping is applied.
!  In the interval Tfade_start < t < Tdamp, damping goes smoothly to zero
!  with continuous derivatives. (The default value for Tfade_start is Tdamp/2.)
!
              ! tau is a normalized t, the transition interval is [-0.5, 0.5]:
              tau = (t-tfade_start) / (tdamp-tfade_start) - 0.5
              if (tau <= -0.5) then
                fade_fact = 1.
              elseif (tau <= 0.5) then
                fade_fact = 0.5 - tau * (1.5 - 2.0*tau**2)
              else
                call fatal_error("udamping","tau is invalid (tau > 0.5).")
              endif
            endif
          endif
!
          if (dampu > 0.0) then
            ! absolute damping per time unit
            df(l1:l2,m,n,iux:iuz) = df(l1:l2,m,n,iux:iuz) &
                                    - fade_fact*dampu*f(l1:l2,m,n,iux:iuz)
          else
            ! dampu < 0: damping per time-step (dt is multiplied in timestep)
            df(l1:l2,m,n,iux:iuz) = df(l1:l2,m,n,iux:iuz) &
                                    + fade_fact*dampu/dt*f(l1:l2,m,n,iux:iuz)
          endif
        endif
!
!  2. damp motions for p%r_mn > rdampext or r_ext AND p%r_mn < rdampint or r_int
!
        if (dampuext > 0.0 .and. rdampext /= impossible) then
          ! outer damping profile
          pdamp = step(p%r_mn,rdampext,wdamp)
          do i=iux,iuz
            df(l1:l2,m,n,i) = df(l1:l2,m,n,i) - dampuext*pdamp*f(l1:l2,m,n,i)
          enddo
        endif
!
        if (dampuint > 0.0 .and. rdampint /= impossible) then
          ! inner damping profile
          pdamp = 1 - step(p%r_mn,rdampint,wdamp)
          do i=iux,iuz
            df(l1:l2,m,n,i) = df(l1:l2,m,n,i) - dampuint*pdamp*f(l1:l2,m,n,i)
          enddo
        endif
!
!  coupling the above internal and external rotation rates to lgravr is not
!  a good idea. So, because of that, spherical Couette flow has to be coded
!  separately.
!  ==> reconsider name <==
!  Allow now also for cylindical Couette flow (if lcylinder_in_a_box=T)
!
        if (lOmega_int) then
!
!  relax outer angular velocity to zero, and
!  calculate work done to sustain zero rotation on outer cylinder/sphere
!
!
          if (lcylinder_in_a_box) then
            pdamp = step(p%rcyl_mn,rdampext,wdamp) ! outer damping profile
          else
            pdamp = step(p%r_mn,rdampext,wdamp) ! outer damping profile
          endif
!
          do i=1,3
            j=iux-1+i
            fext(:,i)=-dampuext*pdamp*f(l1:l2,m,n,j)
            df(l1:l2,m,n,j)=df(l1:l2,m,n,j)+fext(:,i)
          enddo
          if (ldiagnos.and.idiag_fextm/=0) then
            fext_work=f(l1:l2,m,n,iux)*fext(:,1)&
                     +f(l1:l2,m,n,iuy)*fext(:,2)&
                     +f(l1:l2,m,n,iuz)*fext(:,3)
            call sum_mn_name(fext_work,idiag_fextm)
          endif
!
!  internal angular velocity, uref=(-y,x,0)*Omega_int, and
!  calculate work done to sustain uniform rotation on inner cylinder/sphere
!
          if (dampuint > 0.0) then
            if (lcylinder_in_a_box) then
              pdamp = 1 - step(p%rcyl_mn,rdampint,wdamp) ! inner damping profile
            else
              pdamp = 1 - step(p%r_mn,rdampint,wdamp) ! inner damping profile
            endif
            fint(:,1)=-dampuint*pdamp*(f(l1:l2,m,n,iux)+y(m)*Omega_int)
            fint(:,2)=-dampuint*pdamp*(f(l1:l2,m,n,iuy)-x(l1:l2)*Omega_int)
            fint(:,3)=-dampuint*pdamp*(f(l1:l2,m,n,iuz))
            df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)+fint(:,1)
            df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)+fint(:,2)
            df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)+fint(:,3)
            if (ldiagnos.and.idiag_fintm/=0) then
              fint_work=f(l1:l2,m,n,iux)*fint(:,1)&
                       +f(l1:l2,m,n,iuy)*fint(:,2)&
                       +f(l1:l2,m,n,iuz)*fint(:,3)
              call sum_mn_name(fint_work,idiag_fintm)
            endif
          endif
        endif
!
    endsubroutine udamping
!***********************************************************************
    subroutine read_hydro_init_pars(iostat)
!
      use File_io, only: parallel_unit
!
      integer, intent(out) :: iostat
!
      read(parallel_unit, NML=hydro_init_pars, IOSTAT=iostat)
!
    endsubroutine read_hydro_init_pars
!***********************************************************************
    subroutine write_hydro_init_pars(unit)
!
      integer, intent(in) :: unit
!
      write(unit, NML=hydro_init_pars)
!
    endsubroutine write_hydro_init_pars
!***********************************************************************
    subroutine read_hydro_run_pars(iostat)
!
      use File_io, only: parallel_unit
!
      integer, intent(out) :: iostat
!
      read(parallel_unit, NML=hydro_run_pars, IOSTAT=iostat)
!
      if (lSGS_hydro) call read_SGS_hydro_run_pars(iostat)
!
    endsubroutine read_hydro_run_pars
!***********************************************************************
    subroutine write_hydro_run_pars(unit)
!
      integer, intent(in) :: unit
!
      write(unit, NML=hydro_run_pars)
!
      if (lSGS_hydro) call write_SGS_hydro_run_pars(unit)

    endsubroutine write_hydro_run_pars
!***********************************************************************
    subroutine input_persistent_hydro(id,done)
!
!  Dummy. Reads the hydro persistent variables only in 'hydro_kinematic'.
!
      integer, optional :: id
      logical, optional :: done
!
      if (present (id)) call keep_compiler_quiet(id)
      if (present (done)) call keep_compiler_quiet(done)
!
    endsubroutine input_persistent_hydro
!***********************************************************************
    logical function output_persistent_hydro()
!
      output_persistent_hydro = .false.
!
    endfunction output_persistent_hydro
!***********************************************************************
    subroutine rprint_hydro(lreset,lwrite)
!
!  reads and registers print parameters relevant for hydro part
!
!   3-may-02/axel: coded
!  27-may-02/axel: added possibility to reset list
!
      use Diagnostics, only: parse_name
      use FArrayManager, only: farray_index_append
      use General, only: itoa
      use Mpicomm, only: stop_it
!
      integer :: k
      character (len=intlen) :: smode
      integer :: iname,inamez,inamey,inamex,ixy,ixz,irz,inamer,iname_half,inamev,idum
      logical :: lreset,lwr
      logical, optional :: lwrite
!
      lwr = .false.
      if (present(lwrite)) lwr=lwrite
!
!  reset everything in case of reset
!  (this needs to be consistent with what is defined above!)
!
      if (lreset) then
        idiag_u2tm=0
        idiag_uotm=0
        idiag_outm=0
        idiag_fkinzm=0
        idiag_gamm=0
        idiag_gamrms=0
        idiag_gammax=0
        idiag_u2m=0
        idiag_u2sphm=0
        idiag_um2=0
        idiag_uxpt=0
        idiag_uypt=0
        idiag_uzpt=0
        idiag_uxp2=0
        idiag_uyp2=0
        idiag_uzp2=0
        idiag_uxuypt=0
        idiag_uyuzpt=0
        idiag_uzuxpt=0
        idiag_urms=0
        idiag_durms=0
        idiag_urmsx=0
        idiag_urmsz=0
        idiag_umax=0
        idiag_umin=0
        idiag_uxrms=0
        idiag_uyrms=0
        idiag_uzrms=0
        idiag_uzrmaxs=0
        idiag_uxmin=0
        idiag_uymin=0
        idiag_uzmin=0
        idiag_uxmax=0
        idiag_uymax=0
        idiag_uzmax=0
        idiag_uxm=0
        idiag_uym=0
        idiag_uzm=0
        idiag_uzcx10m=0
        idiag_uzsx10m=0
        idiag_ux2m=0
        idiag_uy2m=0
        idiag_uz2m=0
        idiag_ux3m=0
        idiag_uy3m=0
        idiag_uz3m=0
        idiag_ux4m=0
        idiag_uy4m=0
        idiag_uz4m=0
        idiag_uxuy2m=0
        idiag_uyuz2m=0
        idiag_uzux2m=0
        idiag_ux2ccm=0
        idiag_ux2ssm=0
        idiag_uy2ccm=0
        idiag_uy2ssm=0
        idiag_uxuycsm=0
        idiag_rux2m=0
        idiag_ruy2m=0
        idiag_ruz2m=0
        idiag_uduum=0
        idiag_uxmx=0
        idiag_uymx=0
        idiag_uzmx=0
        idiag_ux2mx=0
        idiag_uy2mx=0
        idiag_uz2mx=0
        idiag_ox2mx=0
        idiag_oy2mx=0
        idiag_oz2mx=0
        idiag_ux2my=0
        idiag_uy2my=0
        idiag_uz2my=0
        idiag_ux2mz=0
        idiag_uy2mz=0
        idiag_uz2mz=0
        idiag_uz2upmz=0
        idiag_uz2downmz=0
        idiag_ruxmx=0
        idiag_ruymx=0
        idiag_ruzmx=0
        idiag_rux2mx = 0
        idiag_ruy2mx = 0
        idiag_ruz2mx = 0
        idiag_ruxuymx = 0
        idiag_ruxuzmx = 0
        idiag_ruyuzmx = 0
        idiag_u2mz=0
        idiag_o2mz=0
        idiag_ruxmz=0
        idiag_ruymz=0
        idiag_ruzmz=0
        idiag_rux2mz=0
        idiag_ruy2mz=0
        idiag_ruz2mz=0
        idiag_uxmz=0
        idiag_uymz=0
        idiag_uzmz=0
        idiag_uzupmz=0
        idiag_uzdownmz=0
        idiag_ffdownmz=0
        idiag_ruzupmz=0
        idiag_ruzdownmz=0
        idiag_divumz=0
        idiag_divu2mz=0
        idiag_uzdivumz=0
        idiag_divrhourms=0
        idiag_divrhoumax=0
        idiag_oxmz=0
        idiag_oymz=0
        idiag_ozmz=0
        idiag_ox2mz=0
        idiag_oy2mz=0
        idiag_oz2mz=0
        idiag_uxuym=0
        idiag_uxuzm=0
        idiag_uyuzm=0
        idiag_uxuymx=0
        idiag_uxuzmx=0
        idiag_uyuzmx=0
        idiag_uxuymz=0
        idiag_uxuzmz=0
        idiag_uyuzmz=0
        idiag_uxuymz=0
        idiag_Rxymz=0
        idiag_Rxyupmz=0
        idiag_Rxydownmz=0
        idiag_Rxzmz=0
        idiag_Rxzupmz=0
        idiag_Rxzdownmz=0
        idiag_Ryzmz=0
        idiag_Ryzupmz=0
        idiag_Ryzdownmz=0
        idiag_oxuxxmz=0
        idiag_oyuxymz=0
        idiag_oxuyxmz=0
        idiag_oyuyymz=0
        idiag_oxuzxmz=0
        idiag_oyuzymz=0
        idiag_uyxuzxmz=0
        idiag_uyyuzymz=0
        idiag_uyzuzzmz=0
        idiag_umx=0
        idiag_umy=0
        idiag_umz=0
        idiag_omumz=0
        idiag_umamz=0
        idiag_umbmz=0
        idiag_umxbmz=0
        idiag_divum=0
        idiag_rdivum=0
        idiag_divu2m=0
        idiag_gdivu2m=0
        idiag_u3u21m=0
        idiag_u1u32m=0
        idiag_u2u13m=0
        idiag_u2u31m=0
        idiag_u3u12m=0
        idiag_u1u23m=0
        idiag_u3u21mz=0
        idiag_u1u32mz=0
        idiag_u2u13mz=0
        idiag_u2u31mz=0
        idiag_u3u12mz=0
        idiag_u1u23mz=0
        idiag_acczmz=0
        idiag_acczupmz=0
        idiag_acczdownmz=0
        idiag_accpowzmz=0
        idiag_accpowzupmz=0
        idiag_accpowzdownmz=0
        idiag_totalforcezmz=0
        idiag_totalforcezupmz=0
        idiag_totalforcezdownmz=0
        idiag_urmphi=0
        idiag_ursphmphi=0
        idiag_uthmphi=0
        idiag_rursphmphi=0
        idiag_ruthmphi=0
        idiag_upmphi=0
        idiag_uzmphi=0
        idiag_rurmphi=0
        idiag_rupmphi=0
        idiag_ruzmphi=0
        idiag_u2mphi=0
        idiag_ur2mphi=0
        idiag_up2mphi=0
        idiag_uz2mphi=0
        idiag_urupmphi=0
        idiag_uruzmphi=0
        idiag_upuzmphi=0
        idiag_rurupmphi=0
        idiag_ruruzmphi=0
        idiag_rupuzmphi=0
        idiag_fkinrsphmphi=0
        idiag_uxmy=0
        idiag_uymy=0
        idiag_uzmy=0
        idiag_uxuymy=0
        idiag_uxuzmy=0
        idiag_uyuzmy=0
        idiag_u2mr=0
        idiag_urmr=0
        idiag_upmr=0
        idiag_uzmr=0
        idiag_uxfampm=0
        idiag_uyfampm=0
        idiag_uzfampm=0
        idiag_uxmxz=0
        idiag_uymxz=0
        idiag_uzmxz=0
        idiag_ux2mxz=0
        idiag_uy2mxz=0
        idiag_uz2mxz=0
        idiag_uxuymxz=0
        idiag_uxuzmxz=0
        idiag_uyuzmxz=0
        idiag_uxmxy=0
        idiag_uymxy=0
        idiag_uzmxy=0
        idiag_uxupmxy=0
        idiag_uxdownmxy=0
        idiag_ruxupmxy=0
        idiag_ruxdownmxy=0
        idiag_ux2upmxy=0
        idiag_ux2downmxy=0
        idiag_ffdownmxy=0
        idiag_uxuymxy=0
        idiag_uxuzmxy=0
        idiag_uyuzmxy=0
        idiag_Rxymxy=0
        idiag_Rxyupmxy=0
        idiag_Rxydownmxy=0
        idiag_Rxzmxy=0
        idiag_Rxzupmxy=0
        idiag_Rxzdownmxy=0
        idiag_Ryzmxy=0
        idiag_Ryzupmxy=0
        idiag_Ryzdownmxy=0
        idiag_oxmxy=0
        idiag_oymxy=0
        idiag_ozmxy=0
        idiag_pvzmxy=0
        idiag_ruxmxy=0
        idiag_ruymxy=0
        idiag_ruzmxy=0
        idiag_ux2mxy=0
        idiag_uy2mxy=0
        idiag_uz2mxy=0
        idiag_rux2mxy=0
        idiag_ruy2mxy=0
        idiag_ruz2mxy=0
        idiag_ruxuymxy=0
        idiag_ruxuzmxy=0
        idiag_ruyuzmxy=0
        idiag_ruxm=0
        idiag_ruym=0
        idiag_ruzm=0
        idiag_ruxtot=0
        idiag_rlxm=0
        idiag_rlym=0
        idiag_rlzm=0
        idiag_rlx2m=0
        idiag_rly2m=0
        idiag_rlz2m=0
        idiag_tot_ang_mom=0
        idiag_rumax=0
        idiag_dtu=0
        idiag_oum=0
        idiag_oxum=0
        idiag_ourms=0
        idiag_oxurms=0
        idiag_ou_int=0
        idiag_fum=0
        idiag_odel2um=0
        idiag_o2m=0
        idiag_o2u2m=0
        idiag_o2sphm=0
        idiag_orms=0
        idiag_omax=0
        idiag_ox2m=0
        idiag_oy2m=0
        idiag_oz2m=0
        idiag_ox3m=0
        idiag_oy3m=0
        idiag_oz3m=0
        idiag_ox4m=0
        idiag_oy4m=0
        idiag_oz4m=0
        idiag_oxm=0
        idiag_oym=0
        idiag_ozm=0
        idiag_oxuzxm=0
        idiag_oyuzym=0
        idiag_oxoym=0
        idiag_oxozm=0
        idiag_oyozm=0
        idiag_qfm=0
        idiag_q2m=0
        idiag_qrms=0
        idiag_qmax=0
        idiag_qom=0
        idiag_quxom=0
        idiag_pvzm=0
        idiag_oumx=0
        idiag_oumy=0
        idiag_oumz=0
        idiag_oumxy=0
        idiag_oumxz=0
        idiag_oumphi=0
        idiag_ozmphi=0
        idiag_ormr=0
        idiag_opmr=0
        idiag_ozmr=0
        idiag_Marms=0
        idiag_Mamax=0
        idiag_fintm=0
        idiag_fextm=0
        idiag_divuHrms=0
        idiag_uxxrms=0
        idiag_uyyrms=0
        idiag_uxzrms=0
        idiag_uyzrms=0
        idiag_uzyrms=0
        idiag_duxdzma=0
        idiag_duydzma=0
        idiag_EEK=0
        idiag_ekin=0
        idiag_totangmom=0
        idiag_ekintot=0
        idiag_ekinmx=0
        idiag_ekinmz=0
        idiag_fmasszmz=0
        idiag_fkinzmz=0
        idiag_fkinzdownmz=0
        idiag_fkinzupmz=0
        idiag_fkinxmx=0
        idiag_fkinxmxy=0
        idiag_fkinymxy=0
        idiag_fkinxupmxy=0
        idiag_fkinxdownmxy=0
        idiag_uguxmxy=0
        idiag_uguymxy=0
        idiag_uguzmxy=0
        idiag_ruxuym=0
        idiag_ruxuzm=0
        idiag_ruyuzm=0
        idiag_ruxuymz=0
        idiag_ruxuzmz=0
        idiag_ruyuzmz=0
        idiag_ruxuy2mz=0
        idiag_ruxuz2mz=0
        idiag_ruyuz2mz=0
        idiag_uguxm=0
        idiag_uguym=0
        idiag_uguzm=0
        idiag_ugu2m=0
        idiag_dudx=0
        idiag_ugurmsx=0
        idiag_uguxmx=0
        idiag_uguymx=0
        idiag_uguzmx=0
        idiag_uguxmy=0
        idiag_uguymy=0
        idiag_uguzmy=0
        idiag_uguxmz=0
        idiag_uguymz=0
        idiag_uguzmz=0
        idiag_Remz=0
        idiag_oguxmz=0
        idiag_oguymz=0
        idiag_oguzmz=0
        idiag_ogux2mz=0
        idiag_oguy2mz=0
        idiag_oguz2mz=0
        idiag_oxdivumz=0
        idiag_oydivumz=0
        idiag_ozdivumz=0
        idiag_oxdivu2mz=0
        idiag_oydivu2mz=0
        idiag_ozdivu2mz=0
        idiag_uxglnrym=0
        idiag_uyglnrxm=0
        idiag_uzdivum=0
        idiag_uxuydivum=0
        idiag_urmsh=0;idiag_urmsn=0;idiag_urmss=0
        idiag_ormsh=0;idiag_ormsn=0;idiag_ormss=0
        idiag_oumh=0;idiag_oumn=0;idiag_oums=0
        idiag_udpxxm=0;idiag_udpyym=0;idiag_udpzzm=0
        idiag_udpxym=0;idiag_udpyzm=0;idiag_udpxzm=0
        idiag_taufmin=0
        idiag_dtF=0
        idiag_nshift=0
        ivid_oo=0; ivid_o2=0; ivid_ou=0; ivid_divu=0; ivid_u2=0; ivid_Ma2=0; ivid_uu_sph=0
      endif
!
!  iname runs through all possible names that may be listed in print.in
!
      if (lroot.and.ip<14) print*,'rprint_hydro: run through parse list'
      do iname=1,nname
        call parse_name(iname,cname(iname),cform(iname),'EEK',idiag_EEK)
        call parse_name(iname,cname(iname),cform(iname),'ekin',idiag_ekin)
        call parse_name(iname,cname(iname),cform(iname),'ekintot',idiag_ekintot)
        call parse_name(iname,cname(iname),cform(iname),'gamm',idiag_gamm)
        call parse_name(iname,cname(iname),cform(iname),'gamrms',idiag_gamrms)
        call parse_name(iname,cname(iname),cform(iname),'gammax',idiag_gammax)
        call parse_name(iname,cname(iname),cform(iname),'u2tm',idiag_u2tm)
        call parse_name(iname,cname(iname),cform(iname),'uotm',idiag_uotm)
        call parse_name(iname,cname(iname),cform(iname),'outm',idiag_outm)
        call parse_name(iname,cname(iname),cform(iname),'fkinzm',idiag_fkinzm)
        call parse_name(iname,cname(iname),cform(iname),'u2m',idiag_u2m)
        call parse_name(iname,cname(iname),cform(iname),'u2sphm',idiag_u2sphm)
        call parse_name(iname,cname(iname),cform(iname),'um2',idiag_um2)
        call parse_name(iname,cname(iname),cform(iname),'odel2um',idiag_odel2um)
        call parse_name(iname,cname(iname),cform(iname),'o2m',idiag_o2m)
        call parse_name(iname,cname(iname),cform(iname),'o2u2m',idiag_o2u2m)
        call parse_name(iname,cname(iname),cform(iname),'o2sphm',idiag_o2sphm)
        call parse_name(iname,cname(iname),cform(iname),'oum',idiag_oum)
        call parse_name(iname,cname(iname),cform(iname),'oxum',idiag_oxum)
        call parse_name(iname,cname(iname),cform(iname),'ourms',idiag_ourms)
        call parse_name(iname,cname(iname),cform(iname),'oxurms',idiag_oxurms)
        call parse_name(iname,cname(iname),cform(iname),'ou_int',idiag_ou_int)
        call parse_name(iname,cname(iname),cform(iname),'fum',idiag_fum)
        call parse_name(iname,cname(iname),cform(iname),'oumn',idiag_oumn)
        call parse_name(iname,cname(iname),cform(iname),'oums',idiag_oums)
        call parse_name(iname,cname(iname),cform(iname),'dtu',idiag_dtu)
        call parse_name(iname,cname(iname),cform(iname),'urms',idiag_urms)
        call parse_name(iname,cname(iname),cform(iname),'durms',idiag_durms)
        call parse_name(iname,cname(iname),cform(iname),'urmsx',idiag_urmsx)
        call parse_name(iname,cname(iname),cform(iname),'urmsz',idiag_urmsz)
        call parse_name(iname,cname(iname),cform(iname),'urmsn',idiag_urmsn)
        call parse_name(iname,cname(iname),cform(iname),'urmss',idiag_urmss)
        call parse_name(iname,cname(iname),cform(iname),'umax',idiag_umax)
        call parse_name(iname,cname(iname),cform(iname),'umin',idiag_umin)
        call parse_name(iname,cname(iname),cform(iname),'uxmin',idiag_uxmin)
        call parse_name(iname,cname(iname),cform(iname),'uymin',idiag_uymin)
        call parse_name(iname,cname(iname),cform(iname),'uzmin',idiag_uzmin)
        call parse_name(iname,cname(iname),cform(iname),'uxmax',idiag_uxmax)
        call parse_name(iname,cname(iname),cform(iname),'uymax',idiag_uymax)
        call parse_name(iname,cname(iname),cform(iname),'uzmax',idiag_uzmax)
        call parse_name(iname,cname(iname),cform(iname),'uxrms',idiag_uxrms)
        call parse_name(iname,cname(iname),cform(iname),'uyrms',idiag_uyrms)
        call parse_name(iname,cname(iname),cform(iname),'uzrms',idiag_uzrms)
        call parse_name(iname,cname(iname),cform(iname),'uzrmaxs',idiag_uzrmaxs)
        call parse_name(iname,cname(iname),cform(iname),'uxm',idiag_uxm)
        call parse_name(iname,cname(iname),cform(iname),'uym',idiag_uym)
        call parse_name(iname,cname(iname),cform(iname),'uzm',idiag_uzm)
        call parse_name(iname,cname(iname),cform(iname),'uzcx10m',idiag_uzcx10m)
        call parse_name(iname,cname(iname),cform(iname),'uzsx10m',idiag_uzsx10m)
        call parse_name(iname,cname(iname),cform(iname),'ux2m',idiag_ux2m)
        call parse_name(iname,cname(iname),cform(iname),'uy2m',idiag_uy2m)
        call parse_name(iname,cname(iname),cform(iname),'uz2m',idiag_uz2m)
        call parse_name(iname,cname(iname),cform(iname),'ux3m',idiag_ux3m)
        call parse_name(iname,cname(iname),cform(iname),'uy3m',idiag_uy3m)
        call parse_name(iname,cname(iname),cform(iname),'uz3m',idiag_uz3m)
        call parse_name(iname,cname(iname),cform(iname),'ux4m',idiag_ux4m)
        call parse_name(iname,cname(iname),cform(iname),'uy4m',idiag_uy4m)
        call parse_name(iname,cname(iname),cform(iname),'uz4m',idiag_uz4m)
        call parse_name(iname,cname(iname),cform(iname),'uxuy2m',idiag_uxuy2m)
        call parse_name(iname,cname(iname),cform(iname),'uyuz2m',idiag_uyuz2m)
        call parse_name(iname,cname(iname),cform(iname),'uzux2m',idiag_uzux2m)
        call parse_name(iname,cname(iname),cform(iname),'ux2ccm',idiag_ux2ccm)
        call parse_name(iname,cname(iname),cform(iname),'ux2ssm',idiag_ux2ssm)
        call parse_name(iname,cname(iname),cform(iname),'uy2ccm',idiag_uy2ccm)
        call parse_name(iname,cname(iname),cform(iname),'uy2ssm',idiag_uy2ssm)
        call parse_name(iname,cname(iname),cform(iname),'uxuycsm',idiag_uxuycsm)
        call parse_name(iname,cname(iname),cform(iname),'rux2m',idiag_rux2m)
        call parse_name(iname,cname(iname),cform(iname),'ruy2m',idiag_ruy2m)
        call parse_name(iname,cname(iname),cform(iname),'ruz2m',idiag_ruz2m)
        call parse_name(iname,cname(iname),cform(iname),'uxuym',idiag_uxuym)
        call parse_name(iname,cname(iname),cform(iname),'uxuzm',idiag_uxuzm)
        call parse_name(iname,cname(iname),cform(iname),'uyuzm',idiag_uyuzm)
        call parse_name(iname,cname(iname),cform(iname),'ruxuym',idiag_ruxuym)
        call parse_name(iname,cname(iname),cform(iname),'ruxuzm',idiag_ruxuzm)
        call parse_name(iname,cname(iname),cform(iname),'ruyuzm',idiag_ruyuzm)
        call parse_name(iname,cname(iname),cform(iname),'ox2m',idiag_ox2m)
        call parse_name(iname,cname(iname),cform(iname),'oy2m',idiag_oy2m)
        call parse_name(iname,cname(iname),cform(iname),'oz2m',idiag_oz2m)
        call parse_name(iname,cname(iname),cform(iname),'ox3m',idiag_ox3m)
        call parse_name(iname,cname(iname),cform(iname),'oy3m',idiag_oy3m)
        call parse_name(iname,cname(iname),cform(iname),'oz3m',idiag_oz3m)
        call parse_name(iname,cname(iname),cform(iname),'ox4m',idiag_ox4m)
        call parse_name(iname,cname(iname),cform(iname),'oy4m',idiag_oy4m)
        call parse_name(iname,cname(iname),cform(iname),'oz4m',idiag_oz4m)
        call parse_name(iname,cname(iname),cform(iname),'oxm',idiag_oxm)
        call parse_name(iname,cname(iname),cform(iname),'oym',idiag_oym)
        call parse_name(iname,cname(iname),cform(iname),'ozm',idiag_ozm)
        call parse_name(iname,cname(iname),cform(iname),'oxuzxm',idiag_oxuzxm)
        call parse_name(iname,cname(iname),cform(iname),'oyuzym',idiag_oyuzym)
        call parse_name(iname,cname(iname),cform(iname),'oxoym',idiag_oxoym)
        call parse_name(iname,cname(iname),cform(iname),'oxozm',idiag_oxozm)
        call parse_name(iname,cname(iname),cform(iname),'oyozm',idiag_oyozm)
        call parse_name(iname,cname(iname),cform(iname),'pvzm',idiag_pvzm)
        call parse_name(iname,cname(iname),cform(iname),'orms',idiag_orms)
        call parse_name(iname,cname(iname),cform(iname),'qfm',idiag_qfm)
        call parse_name(iname,cname(iname),cform(iname),'q2m',idiag_q2m)
        call parse_name(iname,cname(iname),cform(iname),'qrms',idiag_qrms)
        call parse_name(iname,cname(iname),cform(iname),'qmax',idiag_qmax)
        call parse_name(iname,cname(iname),cform(iname),'qom',idiag_qom)
        call parse_name(iname,cname(iname),cform(iname),'quxom',idiag_quxom)
        call parse_name(iname,cname(iname),cform(iname),'ormsn',idiag_ormsn)
        call parse_name(iname,cname(iname),cform(iname),'ormss',idiag_ormss)
        call parse_name(iname,cname(iname),cform(iname),'omax',idiag_omax)
        call parse_name(iname,cname(iname),cform(iname),'ruxm',idiag_ruxm)
        call parse_name(iname,cname(iname),cform(iname),'ruym',idiag_ruym)
        call parse_name(iname,cname(iname),cform(iname),'ruzm',idiag_ruzm)
        call parse_name(iname,cname(iname),cform(iname),'ruxtot',idiag_ruxtot)
        call parse_name(iname,cname(iname),cform(iname),'rlxm',idiag_rlxm)
        call parse_name(iname,cname(iname),cform(iname),'rlym',idiag_rlym)
        call parse_name(iname,cname(iname),cform(iname),'rlzm',idiag_rlzm)
        call parse_name(iname,cname(iname),cform(iname),'rlx2m',idiag_rlx2m)
        call parse_name(iname,cname(iname),cform(iname),'rly2m',idiag_rly2m)
        call parse_name(iname,cname(iname),cform(iname),'rlz2m',idiag_rlz2m)
        call parse_name(iname,cname(iname),cform(iname),'tot_ang_mom',idiag_tot_ang_mom)
        call parse_name(iname,cname(iname),cform(iname),'rumax',idiag_rumax)
        call parse_name(iname,cname(iname),cform(iname),'umx',idiag_umx)
        call parse_name(iname,cname(iname),cform(iname),'umy',idiag_umy)
        call parse_name(iname,cname(iname),cform(iname),'umz',idiag_umz)
        call parse_name(iname,cname(iname),cform(iname),'omumz',idiag_omumz)
        call parse_name(iname,cname(iname),cform(iname),'umamz',idiag_umamz)
        call parse_name(iname,cname(iname),cform(iname),'umbmz',idiag_umbmz)
        call parse_name(iname,cname(iname),cform(iname),'umxbmz',idiag_umxbmz)
        call parse_name(iname,cname(iname),cform(iname),'Marms',idiag_Marms)
        call parse_name(iname,cname(iname),cform(iname),'Mamax',idiag_Mamax)
        call parse_name(iname,cname(iname),cform(iname),'divum',idiag_divum)
        call parse_name(iname,cname(iname),cform(iname),'rdivum',idiag_rdivum)
        call parse_name(iname,cname(iname),cform(iname),'divu2m',idiag_divu2m)
        call parse_name(iname,cname(iname),cform(iname),'gdivu2m',idiag_gdivu2m)
        call parse_name(iname,cname(iname),cform(iname),'drurms',idiag_divrhourms)
        call parse_name(iname,cname(iname),cform(iname),'drumax',idiag_divrhoumax)
        call parse_name(iname,cname(iname),cform(iname),'u3u21m',idiag_u3u21m)
        call parse_name(iname,cname(iname),cform(iname),'u1u32m',idiag_u1u32m)
        call parse_name(iname,cname(iname),cform(iname),'u2u13m',idiag_u2u13m)
        call parse_name(iname,cname(iname),cform(iname),'u2u31m',idiag_u2u31m)
        call parse_name(iname,cname(iname),cform(iname),'u3u12m',idiag_u3u12m)
        call parse_name(iname,cname(iname),cform(iname),'u1u23m',idiag_u1u23m)
        call parse_name(iname,cname(iname),cform(iname),'uxpt',idiag_uxpt)
        call parse_name(iname,cname(iname),cform(iname),'uypt',idiag_uypt)
        call parse_name(iname,cname(iname),cform(iname),'uzpt',idiag_uzpt)
        call parse_name(iname,cname(iname),cform(iname),'uxp2',idiag_uxp2)
        call parse_name(iname,cname(iname),cform(iname),'uyp2',idiag_uyp2)
        call parse_name(iname,cname(iname),cform(iname),'uzp2',idiag_uzp2)
        call parse_name(iname,cname(iname),cform(iname),'uxuypt',idiag_uxuypt)
        call parse_name(iname,cname(iname),cform(iname),'uyuzpt',idiag_uyuzpt)
        call parse_name(iname,cname(iname),cform(iname),'uzuxpt',idiag_uzuxpt)
        call parse_name(iname,cname(iname),cform(iname),'fintm',idiag_fintm)
        call parse_name(iname,cname(iname),cform(iname),'fextm',idiag_fextm)
        call parse_name(iname,cname(iname),cform(iname),'divuHrms',idiag_divuHrms)
        call parse_name(iname,cname(iname),cform(iname),'uxxrms',idiag_uxxrms)
        call parse_name(iname,cname(iname),cform(iname),'uyyrms',idiag_uyyrms)
        call parse_name(iname,cname(iname),cform(iname),'uxzrms',idiag_uxzrms)
        call parse_name(iname,cname(iname),cform(iname),'uyzrms',idiag_uyzrms)
        call parse_name(iname,cname(iname),cform(iname),'uzyrms',idiag_uzyrms)
        call parse_name(iname,cname(iname),cform(iname),'duxdzma',idiag_duxdzma)
        call parse_name(iname,cname(iname),cform(iname),'duydzma',idiag_duydzma)
        call parse_name(iname,cname(iname),cform(iname),'totangmom',idiag_totangmom)
        call parse_name(iname,cname(iname),cform(iname),'uxfampm',idiag_uxfampm)
        call parse_name(iname,cname(iname),cform(iname),'uyfampm',idiag_uyfampm)
        call parse_name(iname,cname(iname),cform(iname),'uzfampm',idiag_uzfampm)
        call parse_name(iname,cname(iname),cform(iname),'uxfampim',idiag_uxfampim)
        call parse_name(iname,cname(iname),cform(iname),'uyfampim',idiag_uyfampim)
        call parse_name(iname,cname(iname),cform(iname),'uzfampim',idiag_uzfampim)
        call parse_name(iname,cname(iname),cform(iname),'uguxm',idiag_uguxm)
        call parse_name(iname,cname(iname),cform(iname),'uguym',idiag_uguym)
        call parse_name(iname,cname(iname),cform(iname),'uguzm',idiag_uguzm)
        call parse_name(iname,cname(iname),cform(iname),'dudx',idiag_dudx)
        call parse_name(iname,cname(iname),cform(iname),'ugu2m',idiag_ugu2m)
        call parse_name(iname,cname(iname),cform(iname),'ugurmsx',idiag_ugurmsx)
        call parse_name(iname,cname(iname),cform(iname),'uxglnrym',idiag_uxglnrym)
        call parse_name(iname,cname(iname),cform(iname),'uyglnrxm',idiag_uyglnrxm)
        call parse_name(iname,cname(iname),cform(iname),'uzdivum',idiag_uzdivum)
        call parse_name(iname,cname(iname),cform(iname),'uxuydivum',idiag_uxuydivum)
        call parse_name(iname,cname(iname),cform(iname),'udpxxm',idiag_udpxxm)
        call parse_name(iname,cname(iname),cform(iname),'udpyym',idiag_udpyym)
        call parse_name(iname,cname(iname),cform(iname),'udpzzm',idiag_udpzzm)
        call parse_name(iname,cname(iname),cform(iname),'udpxym',idiag_udpxym)
        call parse_name(iname,cname(iname),cform(iname),'udpyzm',idiag_udpyzm)
        call parse_name(iname,cname(iname),cform(iname),'udpxzm',idiag_udpxzm)
        call parse_name(iname,cname(iname),cform(iname),'taufmin',idiag_taufmin)
        call parse_name(iname,cname(iname),cform(iname),'dtF',idiag_dtF)
        call parse_name(iname,cname(iname),cform(iname),'nshift',idiag_nshift)
        call parse_name(iname,cname(iname),cform(iname),'uduum',idiag_uduum)
      enddo
!
      if (idiag_u2tm/=0) then
        if (iuut==0) call stop_it("Cannot calculate u2tm if iuut==0")
      endif
      if (idiag_outm/=0) then
        if (iuut==0) call stop_it("Cannot calculate outm if iuut==0")
      endif
      if (idiag_uotm/=0) then
        if (ioot==0) call stop_it("Cannot calculate uotm if ioot==0")
      endif
!
!  Loop over spherical harmonic modes.
!
      if (lroot.and.ip<14) print*,'rprint_hydro: run through parse list'

      do k=1,Nmodes_SH
        smode=itoa(k)
!
!  iname runs through all possible names that may be listed in print.in
!
        do iname=1,nname
          call parse_name(iname,cname(iname),cform(iname), &
              'urlm'//trim(smode),idiag_urlm(k))
        enddo
      enddo
!
! Quantities which are averaged over half (north-south) the box
!
      iname_half=name_half_max
      if ((idiag_urmsn/=0).or.(idiag_urmss/=0))then
        iname_half=iname_half+1
        idiag_urmsh=iname_half
      endif
      if ((idiag_ormsn/=0).or.(idiag_ormss/=0))then
        iname_half=iname_half+1
        idiag_ormsh=iname_half
      endif
      if ((idiag_oumn/=0).or.(idiag_oums/=0))then
        iname_half=iname_half+1
        idiag_oumh=iname_half
      endif
      name_half_max=iname_half
!
!  Check for those quantities for which we want yz-averages.
!
      do inamex=1,nnamex
        call parse_name(inamex,cnamex(inamex),cformx(inamex),'uxmx',idiag_uxmx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex),'uymx',idiag_uymx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex),'uzmx',idiag_uzmx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex),'ruxmx',idiag_ruxmx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex),'ruymx',idiag_ruymx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex),'ruzmx',idiag_ruzmx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex),'rux2mx',idiag_rux2mx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex),'ruy2mx',idiag_ruy2mx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex),'ruz2mx',idiag_ruz2mx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex),'ruxuymx',idiag_ruxuymx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex),'ruxuzmx',idiag_ruxuzmx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex),'ruyuzmx',idiag_ruyuzmx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex), &
            'ux2mx',idiag_ux2mx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex), &
            'uy2mx',idiag_uy2mx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex), &
            'uz2mx',idiag_uz2mx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex), &
            'ox2mx',idiag_ox2mx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex), &
            'oy2mx',idiag_oy2mx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex), &
            'oz2mx',idiag_oz2mx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex), &
            'uxuymx',idiag_uxuymx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex), &
            'uxuzmx',idiag_uxuzmx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex), &
            'uyuzmx',idiag_uyuzmx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex),'oumx',idiag_oumx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex), &
            'uguxmx',idiag_uguxmx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex), &
            'uguymx',idiag_uguymx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex), &
            'uguzmx',idiag_uguzmx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex),'ekinmx',idiag_ekinmx)
        call parse_name(inamex,cnamex(inamex),cformx(inamex), &
            'fkinxmx',idiag_fkinxmx)
      enddo
!
!  Check for those quantities for which we want xz-averages.
!
      do inamey=1,nnamey
        call parse_name(inamey,cnamey(inamey),cformy(inamey),'uxmy',idiag_uxmy)
        call parse_name(inamey,cnamey(inamey),cformy(inamey),'uymy',idiag_uymy)
        call parse_name(inamey,cnamey(inamey),cformy(inamey),'uzmy',idiag_uzmy)
        call parse_name(inamey,cnamey(inamey),cformy(inamey), &
            'ux2my',idiag_ux2my)
        call parse_name(inamey,cnamey(inamey),cformy(inamey), &
            'uy2my',idiag_uy2my)
        call parse_name(inamey,cnamey(inamey),cformy(inamey), &
            'uz2my',idiag_uz2my)
        call parse_name(inamey,cnamey(inamey),cformy(inamey), &
            'uxuymy',idiag_uxuymy)
        call parse_name(inamey,cnamey(inamey),cformy(inamey), &
            'uxuzmy',idiag_uxuzmy)
        call parse_name(inamey,cnamey(inamey),cformy(inamey), &
            'uyuzmy',idiag_uyuzmy)
        call parse_name(inamey,cnamey(inamey),cformy(inamey),'oumy',idiag_oumy)
        call parse_name(inamey,cnamey(inamey),cformy(inamey), &
            'uguxmy',idiag_uguxmy)
        call parse_name(inamey,cnamey(inamey),cformy(inamey), &
            'uguymy',idiag_uguymy)
        call parse_name(inamey,cnamey(inamey),cformy(inamey), &
            'uguzmy',idiag_uguzmy)
      enddo
!
!  Check for those quantities for which we want xy-averages.
!
      do inamez=1,nnamez
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'uxmz',idiag_uxmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'uymz',idiag_uymz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'uzmz',idiag_uzmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'uzupmz',idiag_uzupmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'uzdownmz',idiag_uzdownmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'ffdownmz',idiag_ffdownmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'ruzupmz',idiag_ruzupmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'ruzdownmz',idiag_ruzdownmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'divumz',idiag_divumz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'uzdivumz',idiag_uzdivumz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'oxmz',idiag_oxmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'oymz',idiag_oymz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'ozmz',idiag_ozmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'ux2mz',idiag_ux2mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'uy2mz',idiag_uy2mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'uz2mz',idiag_uz2mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'uz2upmz',idiag_uz2upmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'uz2downmz',idiag_uz2downmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'ox2mz',idiag_ox2mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'oy2mz',idiag_oy2mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'oz2mz',idiag_oz2mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'ruxmz',idiag_ruxmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'ruymz',idiag_ruymz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'ruzmz',idiag_ruzmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'rux2mz',idiag_rux2mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'ruy2mz',idiag_ruy2mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'ruz2mz',idiag_ruz2mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
            'uxuymz',idiag_uxuymz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
            'uxuzmz',idiag_uxuzmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
            'uyuzmz',idiag_uyuzmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), 'Rxymz',idiag_Rxymz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), 'Rxyupmz',idiag_Rxyupmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), 'Rxydownmz',idiag_Rxydownmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), 'Rxzmz',idiag_Rxzmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), 'Rxzupmz',idiag_Rxzupmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), 'Rxzdownmz',idiag_Rxzdownmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), 'Ryzmz',idiag_Ryzmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), 'Ryzupmz',idiag_Ryzupmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), 'Ryzdownmz',idiag_Ryzdownmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), 'ruxuymz',idiag_ruxuymz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), 'ruxuzmz',idiag_ruxuzmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), 'ruyuzmz',idiag_ruyuzmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), 'ruxuy2mz',idiag_ruxuy2mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), 'ruxuz2mz',idiag_ruxuz2mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), 'ruyuz2mz',idiag_ruyuz2mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'oxuxxmz',idiag_oxuxxmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'oyuxymz',idiag_oyuxymz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'oxuyxmz',idiag_oxuyxmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'oyuyymz',idiag_oyuyymz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'oxuzxmz',idiag_oxuzxmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'oyuzymz',idiag_oyuzymz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'uyxuzxmz',idiag_uyxuzxmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'uyyuzymz',idiag_uyyuzymz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'uyzuzzmz',idiag_uyzuzzmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
            'fmasszmz',idiag_fmasszmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
            'fkinzmz',idiag_fkinzmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
            'fkinzdownmz',idiag_fkinzdownmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
            'fkinzupmz',idiag_fkinzupmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
            'ekinmz',idiag_ekinmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'u2mz',idiag_u2mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'o2mz',idiag_o2mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'curlru2mz',idiag_curlru2mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'divru2mz',idiag_divru2mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'divu2mz',idiag_divu2mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'oumz',idiag_oumz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
            'uguxmz',idiag_uguxmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
            'uguymz',idiag_uguymz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
            'uguzmz',idiag_uguzmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'Remz',idiag_Remz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'oguxmz', idiag_oguxmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'oguymz', idiag_oguymz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'oguzmz', idiag_oguzmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'ogux2mz',idiag_ogux2mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'oguy2mz',idiag_oguy2mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'oguz2mz',idiag_oguz2mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'oxdivumz', idiag_oxdivumz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'oydivumz', idiag_oydivumz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'ozdivumz', idiag_ozdivumz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'oxdivu2mz',idiag_oxdivu2mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'oydivu2mz',idiag_oydivu2mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez),'ozdivu2mz',idiag_ozdivu2mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
             'u3u21mz',idiag_u3u21mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
             'u1u32mz',idiag_u1u32mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
             'u2u13mz',idiag_u2u13mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
             'u2u31mz',idiag_u2u31mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
             'u3u12mz',idiag_u3u12mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
             'u1u23mz',idiag_u1u23mz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
             'acczmz',idiag_acczmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
             'acczupmz',idiag_acczupmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
             'acczdownmz',idiag_acczdownmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
             'accpowzmz',idiag_accpowzmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
             'accpowzupmz',idiag_accpowzupmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
             'accpowzdownmz',idiag_accpowzdownmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
             'totalforcezmz',idiag_totalforcezmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
             'totalforcezupmz',idiag_totalforcezupmz)
        call parse_name(inamez,cnamez(inamez),cformz(inamez), &
             'totalforcezdownmz',idiag_totalforcezdownmz)
      enddo
!
!  Check for those quantities for which we want y-averages.
!
      do ixz=1,nnamexz
        call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'uxmxz',idiag_uxmxz)
        call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'uymxz',idiag_uymxz)
        call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'uzmxz',idiag_uzmxz)
        call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'ux2mxz',idiag_ux2mxz)
        call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'uy2mxz',idiag_uy2mxz)
        call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'uz2mxz',idiag_uz2mxz)
        call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'uxuymxz',idiag_uxuymxz)
        call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'uxuzmxz',idiag_uxuzmxz)
        call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'uyuzmxz',idiag_uyuzmxz)
        call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'oumxz',idiag_oumxz)
      enddo
!
!  check for those quantities for which we want z-averages
!
      do ixy=1,nnamexy
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'uxmxy',idiag_uxmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'uymxy',idiag_uymxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'uzmxy',idiag_uzmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'ffdownmxy',idiag_ffdownmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'uxupmxy',idiag_uxupmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'uxdownmxy',idiag_uxdownmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'ruxupmxy',idiag_ruxupmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'ruxdownmxy',idiag_ruxdownmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'ux2upmxy',idiag_uxupmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'ux2downmxy',idiag_uxdownmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'uxuymxy',idiag_uxuymxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'uxuzmxy',idiag_uxuzmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'uyuzmxy',idiag_uyuzmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'Rxymxy',idiag_Rxymxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'Rxyupmxy',idiag_Rxyupmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'Rxydownmxy',idiag_Rxydownmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'Rxzmxy',idiag_Rxzmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'Rxzupmxy',idiag_Rxzupmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'Rxzdownmxy',idiag_Rxzdownmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'Ryzmxy',idiag_Ryzmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'Ryzupmxy',idiag_Ryzupmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'Ryzdownmxy',idiag_Ryzdownmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'oxmxy',idiag_oxmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'oymxy',idiag_oymxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'ozmxy',idiag_ozmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'oumxy',idiag_oumxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'pvzmxy',idiag_pvzmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'ruxmxy',idiag_ruxmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'ruymxy',idiag_ruymxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'ruzmxy',idiag_ruzmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'ux2mxy',idiag_ux2mxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'uy2mxy',idiag_uy2mxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'uz2mxy',idiag_uz2mxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'rux2mxy',idiag_rux2mxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'ruy2mxy',idiag_ruy2mxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'ruz2mxy',idiag_ruz2mxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'ruxuymxy',idiag_ruxuymxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'ruxuzmxy',idiag_ruxuzmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'ruyuzmxy',idiag_ruyuzmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'fkinxmxy',idiag_fkinxmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'fkinxupmxy',idiag_fkinxupmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'fkinxdownmxy',idiag_fkinxdownmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'fkinymxy',idiag_fkinymxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'uguxmxy',idiag_uguxmxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'uguymxy',idiag_uguymxy)
        call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'uguzmxy',idiag_uguzmxy)
      enddo
!
!  check for those quantities for which we want phi-averages
!
      do irz=1,nnamerz
        call parse_name(irz,cnamerz(irz),cformrz(irz),'urmphi',idiag_urmphi)
        call parse_name(irz,cnamerz(irz),cformrz(irz),'ursphmphi',idiag_ursphmphi)
        call parse_name(irz,cnamerz(irz),cformrz(irz),'uthmphi',idiag_uthmphi)
        call parse_name(irz,cnamerz(irz),cformrz(irz),'rursphmphi',idiag_rursphmphi)
        call parse_name(irz,cnamerz(irz),cformrz(irz),'ruthmphi',idiag_ruthmphi)
        call parse_name(irz,cnamerz(irz),cformrz(irz),'upmphi',idiag_upmphi)
        call parse_name(irz,cnamerz(irz),cformrz(irz),'uzmphi',idiag_uzmphi)
        call parse_name(irz,cnamerz(irz),cformrz(irz),'rurmphi',idiag_rurmphi)
        call parse_name(irz,cnamerz(irz),cformrz(irz),'rupmphi',idiag_rupmphi)
        call parse_name(irz,cnamerz(irz),cformrz(irz),'ruzmphi',idiag_ruzmphi)
        call parse_name(irz,cnamerz(irz),cformrz(irz),'ur2mphi',idiag_ur2mphi)
        call parse_name(irz,cnamerz(irz),cformrz(irz),'up2mphi',idiag_up2mphi)
        call parse_name(irz,cnamerz(irz),cformrz(irz),'uz2mphi',idiag_uz2mphi)
        call parse_name(irz,cnamerz(irz),cformrz(irz),'u2mphi',idiag_u2mphi)
        call parse_name(irz,cnamerz(irz),cformrz(irz),'urupmphi',idiag_urupmphi)
        call parse_name(irz,cnamerz(irz),cformrz(irz),'uruzmphi',idiag_uruzmphi)
        call parse_name(irz,cnamerz(irz),cformrz(irz),'upuzmphi',idiag_upuzmphi)
        call parse_name(irz,cnamerz(irz),cformrz(irz),'rurupmphi',idiag_rurupmphi)
        call parse_name(irz,cnamerz(irz),cformrz(irz),'ruruzmphi',idiag_ruruzmphi)
        call parse_name(irz,cnamerz(irz),cformrz(irz),'rupuzmphi',idiag_rupuzmphi)
        call parse_name(irz,cnamerz(irz),cformrz(irz),'oumphi',idiag_oumphi)
        call parse_name(irz,cnamerz(irz),cformrz(irz),'ozmphi',idiag_ozmphi)
        call parse_name(irz,cnamerz(irz),cformrz(irz),'fkinrsphmphi',idiag_fkinrsphmphi)
      enddo
!
!  check for those quantities for which we want phiz-averages
!
      do inamer=1,nnamer
        call parse_name(inamer,cnamer(inamer),cformr(inamer),'urmr',  idiag_urmr)
        call parse_name(inamer,cnamer(inamer),cformr(inamer),'upmr',  idiag_upmr)
        call parse_name(inamer,cnamer(inamer),cformr(inamer),'uzmr',  idiag_uzmr)
        call parse_name(inamer,cnamer(inamer),cformr(inamer),'ormr',  idiag_ormr)
        call parse_name(inamer,cnamer(inamer),cformr(inamer),'opmr',  idiag_opmr)
        call parse_name(inamer,cnamer(inamer),cformr(inamer),'ozmr',  idiag_ozmr)
        call parse_name(inamer,cnamer(inamer),cformr(inamer),'u2mr',  idiag_u2mr)
      enddo
!
!  check for those quantities for which we want video slices
!
      idum=0
      do inamev=1,nnamev
        call parse_name(inamev,cnamev(inamev),cformv(inamev),'uu',  idum)
        call parse_name(inamev,cnamev(inamev),cformv(inamev),'oo',  ivid_oo)
        call parse_name(inamev,cnamev(inamev),cformv(inamev),'o2',  ivid_o2)
        call parse_name(inamev,cnamev(inamev),cformv(inamev),'ou',  ivid_ou)
        call parse_name(inamev,cnamev(inamev),cformv(inamev),'divu',ivid_divu)
        call parse_name(inamev,cnamev(inamev),cformv(inamev),'u2',  ivid_u2)
        call parse_name(inamev,cnamev(inamev),cformv(inamev),'Ma2', ivid_Ma2)
        call parse_name(inamev,cnamev(inamev),cformv(inamev),'uu_sph',ivid_uu_sph)
      enddo
!
!  write column where which hydro variable is stored
!
      if (lwr) then
        if (lhelmholtz_decomp) call farray_index_append('iphiuu',iphiuu)
      endif
!
      if (lSGS_hydro) call rprint_SGS_hydro(lreset,lwrite)

    endsubroutine rprint_hydro
!***********************************************************************
    subroutine get_slices_hydro(f,slices)
!
!  Write slices for animation of Hydro variables.
!
!  26-jul-06/tony: coded
!  12-apr-16/MR: modifications for Yin-Yang grid
!
      use General, only: transform_thph_yy_other
      use Slices_methods, only: assign_slices_scal, assign_slices_vec

      real, dimension (mx,my,mz,mfarray) :: f
      type (slice_data) :: slices
!
!  Loop over slices
!
      select case (trim(slices%name))
!
!  Velocity field.
!
        case ('uu'); call assign_slices_vec(slices,f,iuu)
!
!  Divergence of velocity.
!
        case ('divu')
          call assign_slices_scal(slices,divu_xy,divu_xz,divu_yz,divu_xy2,divu_xy3,divu_xy4,divu_xz2,divu_r)
!
!  Velocity squared.
!
        case ('u2')
          call assign_slices_scal(slices,u2_xy,u2_xz,u2_yz,u2_xy2,u2_xy3,u2_xy4,u2_xz2,u2_r)
!
!  Vorticity.
!
        case ('oo')
          call assign_slices_vec(slices,oo_xy,oo_xz,oo_yz,oo_xy2,oo_xy3,oo_xy4,oo_xz2,oo_r)
!
!  Vorticity squared.
!
        case ('o2')
          call assign_slices_scal(slices,o2_xy,o2_xz,o2_yz,o2_xy2,o2_xy3,o2_xy4,o2_xz2,o2_r)
!
!  kinetic helicity.
!
        case ('ou')
          call assign_slices_scal(slices,ou_xy,ou_xz,ou_yz,ou_xy2,ou_xy3,ou_xy4,ou_xz2,ou_r)
!
!  Mach number squared.
!
        case ('Ma2')
          call assign_slices_scal(slices,mach_xy,mach_xz,mach_yz,mach_xy2,mach_xy3,mach_xy4,mach_xz2,mach_r)
!
!  Velocity in spherical coordinates
!
        case ('uu_sph')
          call assign_slices_vec(slices,uu_sph_xy,uu_sph_xz,uu_sph_yz,uu_sph_xy2, &
                                        uu_sph_xy3,uu_sph_xy4,uu_sph_xz2,uu_sph_r)
!
      endselect
!
    endsubroutine get_slices_hydro
!***********************************************************************
    function decomp_prepare() result (ldecomp)
!
!  Prepare for Helmholtz decomposition.
!
!  20-oct-97/axel: coded
!
      use Sub, only: read_snaptime, update_snaptime
!
      logical :: ldecomp

      character (len=fnlen) :: file
      integer :: ndummy
      real :: tdummy
!
!  Perform the decomposition in dsnap_down time intervals.
!
      file = trim(datadir)//'/tsnap_down.dat'
!
!  This routine sets ldecomp=T whenever its time to perform the decomposition.
!
      call update_snaptime(file,tdummy,ndummy,dsnap_down,t,ldecomp,nowrite=.true.)
!
    endfunction decomp_prepare
!***********************************************************************
    subroutine hydro_after_timestep(f,df,dt_sub)
!
!  Hook for modification of the f and df arrays
!  according to the hydro module, after the
!  timestep is performed.
!
!  12-mar-17/wlyra: coded.
!  28-mar-17/MR: reinstated update_ghosts.
!
      use Boundcond, only: update_ghosts
      use Sub, only: div
      use Poisson, only: inverse_laplacian, inverse_laplacian_fft_z    !, inverse_laplacian_z_2nd_neumann
!
      real, dimension(mx,my,mz,mfarray) :: f
      real, dimension(mx,my,mz,mvar) :: df
      real :: dt_sub
!
      logical :: lwrite_debug=.false.
      integer :: iorder_z=2
!
      fargo: if (lfargo_advection) then
!
!  Call update ghosts as derivatives are needed.
!
        call update_ghosts(f)
!
        fourier: if (lfargoadvection_as_shift) then
          call fourier_shift_fargo(f,df,dt_sub)
        else
          if (lroot) then
            print*,'Fargo advection without Fourier shift'
            print*,'is not functional.'
            call fatal_error("hydro_after_timestep","")
          endif
        endif fourier
!
!  To disable radial advection, intended for tests in cylindrical coordinates
!
        if (lno_radial_advection) then
          f(:,:,:,iux) = 0.
          df(:,:,:,iux) = 0.
        endif
!
      endif fargo

      if (lhelmholtz_decomp) then 

        !call fatal_error("hydro_after_timestep","Helmholtz decomposition not yet operational")
        if (it==1) call warning("hydro_after_timestep","Helmholtz decomposition under development")

        !if (decomp_prepare()) then
        if (.true.) then
!
!  Find the divergence of uu and put it into the f-slot which is later used for the flow potential.
!
          do n=n1,n2; do m=m1,m2
            call div(f,iuu,f(l1:l2,m,n,iphiuu))
          enddo; enddo
!
!print*, 'minmax(div)=', minval(f(l1:l2,m1:m2,n1:n2,iphiuu)),maxval(f(l1:l2,m1:m2,n1:n2,iphiuu))
!          if (lwrite_debug) write(31) f(l1:l2,m1:m2,n1:n2,iphiuu)
!
          if (lperi(3)) then
            call inverse_laplacian(f(l1:l2,m1:m2,n1:n2,iphiuu))
          else
            call fatal_error('hydro_after_timestep','Helmholtz decomposition not yet operational')
            if (iorder_z==2) then
              !call inverse_laplacian_z_2nd_neumann(f)
            else
              ! call inverse_laplacian_fft_z(f(l1:l2,m1:m2,n1:n2,iphiuu))
              ! call inverse_laplacian_z(f(l1:l2,m1:m2,n1:n2,iphiuu),(/'n1s','n1s'/),f(:,:,n1,iuz),f(:,:,n2,iuz))
            endif
          endif
          if (lwrite_debug) write(32) f(l1:l2,4,n1:n2,iphiuu)

        endif
      endif
!
    endsubroutine hydro_after_timestep
!***********************************************************************
    subroutine fourier_shift_fargo(f,df,dt_)
!
!  Add the fargo shift to the f and df-array, in
!  fourier space.
!
!  12-mar-17/wlyra: moved here from special
!
      use Sub
      use Fourier, only: fft_y_parallel,fft_z_parallel
      use Cdata
      use Mpicomm
!
      real, dimension (mx,my,mz,mfarray) :: f
      real, dimension (mx,my,mz,mvar) :: df
      real, dimension (nx,ny) :: acyl_re,acyl_im
      real, dimension (nz) :: asph_re,asph_im
      real, dimension (nx) :: phidot
      integer :: ivar,ig,i
      real :: dt_
!
!  Pencil uses linear velocity. Fargo will shift based on
!  angular velocity. Get phidot from uphi.
!
      ifcoordinates: if (lcylindrical_coords) then
        zloopcyl: do n=n1,n2
          phidot=uu_average_cyl(l1:l2,n)*rcyl_mn1
!
          varloopcyl: do ivar=1,mvar
!
            acyl_re=f(l1:l2,m1:m2,n,ivar)
            acyl_im=0.
!
!  Forward transform. No need for computing the imaginary part.
!  The transform is just a shift in y, so no need to compute
!  the x-transform either.
!
            call fft_y_parallel(acyl_re,acyl_im,SHIFT_Y=phidot*dt_,lneed_im=.false.)
!
!  Inverse transform of the shifted array back into real space.
!  No need again for either imaginary part of x-transform.
!
            call fft_y_parallel(acyl_re,acyl_im,linv=.true.)
            f(l1:l2,m1:m2,n,ivar)=acyl_re
!
!  Also shift df, unless it is the last subtimestep.
!
            if (.not.llast) then
              acyl_re=df(l1:l2,m1:m2,n,ivar)
              acyl_im=0.
              call fft_y_parallel(acyl_re,acyl_im,SHIFT_Y=phidot*dt_,lneed_im=.false.)
              call fft_y_parallel(acyl_re,acyl_im,linv=.true.)
              df(l1:l2,m1:m2,n,ivar)=acyl_re
            endif
!
          enddo varloopcyl
        enddo zloopcyl
      elseif (lspherical_coords) then
        yloopsph: do m=m1,m2
          xloopsph: do i=l1,l2
            ig=i-l1+1
            phidot=uu_average_sph(l1:l2,m)*rcyl_mn1
!
            varloopsph: do ivar=1,mvar
!
              asph_re=f(i,m,n1:n2,ivar)
              asph_im=0.
!
!  Forward transform. No need for computing the imaginary part.
!  The transform is just a shift in z, so no need to compute
!  the x-transform either.
!
              call fft_z_parallel(asph_re,asph_im,SHIFT_Z=phidot(ig)*dt_,lneed_im=.false.)
!
!  Inverse transform of the shifted array back into real space.
!  No need again for either imaginary part of x-transform.
!
              call fft_z_parallel(asph_re,asph_im,linv=.true.)
              f(i,m,n1:n2,ivar)=asph_re
!
!  Also shift df, unless it is the last subtimestep.
!
              if (.not.llast) then
                asph_re=df(i,m,n1:n2,ivar)
                asph_im=0.
                call fft_z_parallel(asph_re,asph_im,SHIFT_Z=phidot(ig)*dt_,lneed_im=.false.)
                call fft_z_parallel(asph_re,asph_im,linv=.true.)
                df(i,m,n1:n2,ivar)=asph_re
              endif
!
            enddo varloopsph
          enddo xloopsph
        enddo yloopsph
      endif ifcoordinates
!
    endsubroutine fourier_shift_fargo
!***********************************************************************
    subroutine calc_mflow
!
!  calculate mean flow field from xy- or z-averages
!
!   8-nov-02/axel: adapted from calc_mfield
!   9-nov-02/axel: allowed mean flow to be compressible
!  24-aug-15/MR: corrected declaration of umx2
!
      use Diagnostics, only: save_name
      use Mpicomm, only: mpibcast_real, mpireduce_sum
!
      logical,save :: first=.true.
      real, dimension (nx,ny) :: fsumxy
      real, dimension (nx) :: uxmx,uymx,uzmx,umx2
      real, dimension (ny) :: uxmy,uymy,uzmy,umy2
      real :: umx,umy,umz
!
!  For vector output (of oo vectors) we need orms
!  on all processors. It suffices to have this for times when lout=.true.,
!  but we need to broadcast the result to all procs.
!
!  calculate orms (this requires that orms is set in print.in)
!  broadcast result to other processors
!
      if (idiag_orms/=0) then
        if (iproc==0) orms=fname(idiag_orms)
        call mpibcast_real(orms)
      endif
!
!  Magnetic energy in vertically averaged field. The uymxy and uzmxy must
!  have been calculated, so they are present on the z-root processors.
!
      if (idiag_umx/=0) then
        if (idiag_uymxy==0.or.idiag_uzmxy==0) then
          if (first) print*, 'calc_mflow:                    WARNING'
          if (first) print*, &
                  "calc_mflow: NOTE: to get umx, uymxy and uzmxy must also be set in zaver"
          if (first) print*, &
                  "calc_mflow:      We proceed, but you'll get umx=0"
          umx=0.
        else
          if (lfirst_proc_z) then
            call mpireduce_sum(fnamexy(idiag_uxmxy,:,:),fsumxy,(/nx,ny/),idir=2)
            uxmx=sum(fsumxy,dim=2)/nygrid
            call mpireduce_sum(fnamexy(idiag_uymxy,:,:),fsumxy,(/nx,ny/),idir=2)
            uymx=sum(fsumxy,dim=2)/nygrid
            call mpireduce_sum(fnamexy(idiag_uzmxy,:,:),fsumxy,(/nx,ny/),idir=2)
            uzmx=sum(fsumxy,dim=2)/nygrid
          endif
          if (lfirst_proc_yz) &
            call mpireduce_sum(uxmx**2+uymx**2+uzmx**2,umx2,nx,idir=1)
          umx=sqrt(sum(umx2)/nxgrid)
        endif
        call save_name(umx,idiag_umx)
      endif
!
!  Similarly for umy.
!
      if (idiag_umy/=0) then
        if (idiag_uxmxy==0.or.idiag_uzmxy==0) then
          if (first) print*, 'calc_mflow:                    WARNING'
          if (first) print*, &
                  "calc_mflow: NOTE: to get umy, uxmxy and uzmxy must also be set in zaver"
          if (first) print*, &
                  "calc_mflow:       We proceed, but you'll get umy=0"
          umy=0.
        else
          if (lfirst_proc_z) then
            call mpireduce_sum(fnamexy(idiag_uxmxy,:,:),fsumxy,(/nx,ny/),idir=1)
            uxmy=sum(fsumxy,dim=1)/nxgrid
            call mpireduce_sum(fnamexy(idiag_uymxy,:,:),fsumxy,(/nx,ny/),idir=1)
            uymy=sum(fsumxy,dim=1)/nxgrid
            call mpireduce_sum(fnamexy(idiag_uzmxy,:,:),fsumxy,(/nx,ny/),idir=1)
            uzmy=sum(fsumxy,dim=1)/nxgrid
          endif
          if (lfirst_proc_xz) &
            call mpireduce_sum(uxmy**2+uymy**2+uzmy**2,umy2,ny,idir=2)
          umy=sqrt(sum(umy2)/nygrid)
        endif
        call save_name(umy,idiag_umy)
      endif
!
!  Kinetic energy in horizontally averaged flow. The uxmz and uymz must
!  have been calculated, so they are present on the root processor.
!
      if (idiag_umz/=0) then
        if (idiag_uxmz==0.or.idiag_uymz==0.or.idiag_uzmz==0) then
          if (first) print*,"calc_mflow:                    WARNING"
          if (first) print*, &
                  "calc_mflow: NOTE: to get umz, uxmz, uymz and uzmz must also be set in xyaver"
          if (first) print*, &
                  "calc_mflow:       This may be because we renamed zaver.in into xyaver.in"
          if (first) print*, &
                  "calc_mflow:       We proceed, but you'll get umz=0"
          umz=0.
        else
          umz=sqrt(sum(fnamez(:,:,idiag_uxmz)**2 &
                      +fnamez(:,:,idiag_uymz)**2 &
                      +fnamez(:,:,idiag_uzmz)**2)/(nz*nprocz))
        endif
        call save_name(umz,idiag_umz)
      endif
!
!  calculation of <U>.<B> in separate subroutine.
!  Should do the same for <Ux^2>, <Uy^2>, <Uz^2> later (as in magnetic)
!
      if (idiag_omumz/=0) call calc_omumz
      if (idiag_umamz/=0) call calc_umamz
      if (idiag_umbmz/=0) call calc_umbmz
      if (idiag_umxbmz/=0) call calc_umxbmz
!
      first = .false.
!
    endsubroutine calc_mflow
!***********************************************************************
    subroutine calc_omumz
!
!  Calculate kinetic helicity of mean field
!  The oxmz and oymz as well as uxmz and uymz must have been calculated,
!  so they are present on the root processor.
!
!  14-feb-09/axel: adapted from calc_umbmz
!
      use Diagnostics, only: save_name
!
      logical,save :: first=.true.
      real :: omumz
!
!  This only works if uxmz, uymz, bxmz, bymz, are in xyaver,
!  so print warning if this is not ok.
!
      if (idiag_oxmz==0.or.idiag_oymz==0.or.idiag_uxmz==0.or.idiag_uymz==0) then
        if (first) then
          print*,"calc_mfield: WARNING"
          print*,"NOTE: to get omumz, set uxmz, uymz, oxmz, and oymz in xyaver"
          print*,"We proceed, but you'll get omumz=0"
        endif
        omumz=0.
      else
        omumz=sum(fnamez(:,:,idiag_oxmz)*fnamez(:,:,idiag_uxmz) &
                 +fnamez(:,:,idiag_oymz)*fnamez(:,:,idiag_uymz))/(nz*nprocz)
      endif
!
!  save the name in the idiag_omumz slot
!  and set first to false
!
      call save_name(omumz,idiag_omumz)
      first=.false.
!
    endsubroutine calc_omumz
!***********************************************************************
    subroutine calc_umamz
!
!  Cross helicity production of mean field
!  The uxmz and uymz as well as axmz and aymz must have been calculated,
!  so they are present on the root processor.
!
!   5-mar-10/axel: adapted from calc_umbmz
!
      use Diagnostics, only: save_name
      use Magnetic, only: idiag_axmz, idiag_aymz
!
      logical,save :: first=.true.
      real :: umamz
!
!  This only works if uxmz, uymz, axmz, aymz, are in xyaver,
!  so print warning if this is not ok.
!
      if (idiag_uxmz==0.or.idiag_uymz==0.or.idiag_axmz==0.or.idiag_aymz==0) then
        if (first) then
          print*,"calc_mfield: WARNING"
          print*,"NOTE: to get umamz, set uxmz, uymz, axmz, and aymz in xyaver"
          print*,"We proceed, but you'll get umamz=0"
        endif
        umamz=0.
      else
        umamz=sum(fnamez(:,:,idiag_uxmz)*fnamez(:,:,idiag_axmz) &
                 +fnamez(:,:,idiag_uymz)*fnamez(:,:,idiag_aymz))/(nz*nprocz)
      endif
!
!  save the name in the idiag_umamz slot
!  and set first to false
!
      call save_name(umamz,idiag_umamz)
      first=.false.
!
    endsubroutine calc_umamz
!***********************************************************************
    subroutine calc_umbmz
!
!  Cross helicity production of mean field
!  The uxmz and uymz as well as bxmz and bymz must have been calculated,
!  so they are present on the root processor.
!
!  26-jan-09/axel: adapted from calc_ebmz
!
      use Diagnostics, only: save_name
      use Magnetic, only: idiag_bxmz,idiag_bymz
!
      logical,save :: first=.true.
      real :: umbmz
!
!  This only works if uxmz, uymz, bxmz, bymz, are in xyaver,
!  so print warning if this is not ok.
!
      if (idiag_uxmz==0.or.idiag_uymz==0.or.idiag_bxmz==0.or.idiag_bymz==0) then
        if (first) then
          print*,"calc_mfield: WARNING"
          print*,"NOTE: to get umbmz, set uxmz, uymz, bxmz, and bymz in xyaver"
          print*,"We proceed, but you'll get umbmz=0"
        endif
        umbmz=0.
      else
        umbmz=sum(fnamez(:,:,idiag_uxmz)*fnamez(:,:,idiag_bxmz) &
                 +fnamez(:,:,idiag_uymz)*fnamez(:,:,idiag_bymz))/(nz*nprocz)
      endif
!
!  save the name in the idiag_umbmz slot
!  and set first to false
!
      call save_name(umbmz,idiag_umbmz)
      first=.false.
!
    endsubroutine calc_umbmz
!***********************************************************************
    subroutine calc_umxbmz
!
!  EMF of xy-averaged mean velocity and magnetic fields
!  The uxmz and uymz as well as bxmz and bymz must have been calculated,
!  so they are present on the root processor.
!
!  17-mar-09/axel: adapted from calc_umbmz
!
      use Diagnostics, only: save_name
      use Magnetic, only: idiag_bxmz,idiag_bymz
!
      logical,save :: first=.true.
      real :: umxbmz
!
!  This only works if uxmz, uymz, bxmz, bymz, are in xyaver,
!  so print warning if this is not ok.
!
      if (idiag_uxmz==0.or.idiag_uymz==0.or.idiag_bxmz==0.or.idiag_bymz==0) then
        if (first) then
          print*,"calc_mfield: WARNING"
          print*,"NOTE: to get umxbmz, set uxmz, uymz, bxmz, and bymz in xyaver"
          print*,"We proceed, but you'll get umxbmz=0"
        endif
        umxbmz=0.
      else
        umxbmz=sum(fnamez(:,:,idiag_uxmz)*fnamez(:,:,idiag_bymz) &
                  -fnamez(:,:,idiag_uymz)*fnamez(:,:,idiag_bxmz))/(nz*nprocz)
      endif
!
!  save the name in the idiag_umxbmz slot
!  and set first to false
!
      call save_name(umxbmz,idiag_umxbmz)
      first=.false.
!
    endsubroutine calc_umxbmz
!***********************************************************************
    subroutine remove_mean_momenta(f,indux,indrho)
!
!  Substract mean x-momentum over density from the x-velocity field.
!  Useful to avoid unphysical winds in shearing box simulations.
!  Note: this is possibly not useful when there is rotation, because
!  then epicyclic motions don't usually grow catastrophically.
!
!  15-nov-06/tobi: coded
!  15-dec-10/MR  : added parameters indux, indrho to make routine applicable
!                  to other velocities/densities
!  13-feb-15/MR  : changes for use of reference_state (used for main run density only)
!
      use Mpicomm, only: mpiallreduce_sum
!
      real, dimension (mx,my,mz,mfarray), intent(inout)        :: f
      integer,                            intent(in)           :: indux
      integer,                            intent(in), optional :: indrho
!
      real, dimension (nx) :: rho,rho1,mm
      real :: fac
      real, dimension (indux:indux+2) :: rum, rum_tmp
      integer :: m,n,j,indrhol
      logical :: lref
!
!  check if ldensity=T. Otherwise switch to remove_mean_flow.
!
      if (ldensity) then
!
!  initialize mean momentum, rum, to zero
!
        lref=.false.
        if (present(indrho)) then
          indrhol = indrho
        else if (indux==iux) then
!
          if (ldensity_nolog) then
            indrhol = irho
          else
            indrhol = ilnrho
          endif
          lref=lreference_state
!
        else
!
! for testflow
!
          indrhol = indux+3
        endif
!
        rum = 0.0
        fac = 1.0/nwgrid
!
!  Go through all pencils.
!
        do n = n1,n2
        do m = m1,m2
!
!  Compute density from the f-array.
!
          if (ldensity_nolog) then
            rho = f(l1:l2,m,n,indrhol)
            if (lref) rho=rho+reference_state(:,iref_rho)
          else
            rho = exp(f(l1:l2,m,n,indrhol))
          endif
!
!  Compute mean momentum in each of the 3 directions.
!
          do j=indux,indux+2
            mm = rho*f(l1:l2,m,n,j)
            rum(j) = rum(j) + fac*sum(mm)
          enddo
        enddo
        enddo
!
!  Compute total sum for all processors.
!  Allow here for the possibility to add mean_momentum.
!  It needs to be subtracted here, because "rum" is removed.
!
        call mpiallreduce_sum(rum,rum_tmp,3)
        rum = rum_tmp - mean_momentum
!
!  Compute inverse density, rho1.
!
        do n = n1,n2
        do m = m1,m2
          if (ldensity_nolog) then
            if (lref) then
              rho1 = 1./(f(l1:l2,m,n,indrhol)+reference_state(:,iref_rho))
            else
              rho1 = 1./f(l1:l2,m,n,indrhol)
            endif
          else
            rho1 = exp(-f(l1:l2,m,n,indrhol))
          endif
!
!  Subtract out the mean momentum separately for each direction.
!
          do j=indux,indux+2
            f(l1:l2,m,n,j) = f(l1:l2,m,n,j) - rho1*rum(j)
          enddo
        enddo
        enddo
        if (lroot.and.ip<6) print*,'remove_mean_momenta: rum=',rum
      else
        call remove_mean_flow(f,indux)       ! as this is equivalent to remove
                                             ! mean momenta for constant density
      endif
    endsubroutine remove_mean_momenta
!***********************************************************************
    subroutine remove_mean_flow(f,indux)
!
!  Substract mean x-flow from the x-velocity field.
!  Useful to avoid unphysical winds in shearing box simulations.
!  Note: this is possibly not useful when there is rotation, because
!  then epicyclic motions don't usually grow catastrophically.
!
!  22-may-07/axel: adapted from remove_mean_momenta
!  15-dec-10/MR  : added parameters indux to make routine applicable
!                  to other velocities
!
      use Mpicomm, only: mpiallreduce_sum
!
      real, dimension (mx,my,mz,mfarray), intent (inout) :: f
      integer,                            intent (in)    :: indux
!
      real, dimension (indux:indux+2) :: um, um_tmp
      integer :: m,n,j
      real    :: fac
!
!  initialize um and compute normalization factor fac
!
        um = 0.0
        fac = 1.0/nwgrid
!
!  Go through all pencils.
!
        do n = n1,n2
        do m = m1,m2
!
!  Compute mean flow in each of the 3 directions.
!
          do j=indux,indux+2
            um(j) = um(j) + fac*sum(f(l1:l2,m,n,j))
          enddo
        enddo
        enddo
!
!  Compute total sum for all processors
!
        call mpiallreduce_sum(um,um_tmp,3)
        um = um_tmp
!
!  Go through all pencils and subtract out the mean flow
!  separately for each direction.
!
        do n = n1,n2
        do m = m1,m2
          do j=indux,indux+2
            f(l1:l2,m,n,j) = f(l1:l2,m,n,j) - um(j)
          enddo
        enddo
        enddo
!
        if (lroot.and.ip<6) print*,'remove_mean_flow: um=',um
!
    endsubroutine remove_mean_flow
!***********************************************************************
    subroutine remove_mean_angmom(f,induz)
!
!  Substract <L_z>/<rho*sin(theta)> from z-flow. Useful to avoid
!  unphysical accumulation of angular momentum in spherical
!  coordinates.
!
!  29-aug-13/pete: adapted from remove_mean_flow
!  30-jan-15/pete: take reference state into account
!  13-feb-15/MR  : some optimizations
!
      use Mpicomm, only: mpiallreduce_sum
      use DensityMethods, only: getrho
!
      real, dimension (mx,my,mz,mfarray), intent (inout) :: f
      integer,                            intent (in)    :: induz
!
      real, dimension (nx) :: tmp, rho, wx
      real :: um, angmom, angmom_tmp, rhosint, rhosint_tmp, fac, wmn
      integer :: m,n
!
!  Initialize um and compute normalization factor fac
!
      angmom = 0.0
      rhosint = 0.0
      fac = 1./(Lxyz(1)*(cos(y0)-cos(y0+Lxyz(2)))*Lxyz(3))
      wx=x(l1:l2)*dVol_x(l1:l2)
!
!  Go through all pencils.
!
      do n = n1,n2
        do m = m1,m2
!
!  Compute volume integrals of angular momentum and rho*sin(theta)
!
          call getrho(f(:,m,n,ilnrho),rho)
!
          tmp=rho*wx
          wmn=sinth(m)*dVol_y(m)*dVol_z(n)
          angmom=angmom+sum(tmp*f(l1:l2,m,n,induz))*wmn
          rhosint=rhosint+sum(tmp)*wmn
!
        enddo
      enddo
!
      angmom=fac*angmom; rhosint=fac*rhosint
!
!  Compute total sum for all processors
!
      call mpiallreduce_sum(angmom,angmom_tmp)
      call mpiallreduce_sum(rhosint,rhosint_tmp)
      um=angmom_tmp/rhosint_tmp
!
!  Go through all pencils and subtract out the excess u_phi
!
      f(l1:l2,m1:m2,n1:n2,induz) = f(l1:l2,m1:m2,n1:n2,induz) - um
!
      if (lroot.and.ip<6) print*,'remove_mean_angmom: um=',um
!
    endsubroutine remove_mean_angmom
!***********************************************************************
    subroutine interior_bc_hydro(f)
!
!  Set interior boundary condition within the domain
!
!  11-jun-08/axel: coded
!
      real, dimension (mx,my,mz,mfarray), intent (inout) :: f
      integer :: l1bc,l2bc
!
      select case (interior_bc_hydro_profile)
!
!  single propeller blade
!
      case ('blade')
        z1_interior_bc_hydro=2.
        l1bc=(l1+l2)/2
        l2bc=l1bc+1
        do n=n1,n2
          if (z(n)<z1_interior_bc_hydro) then
            do m=m1,m2
              f(l1bc:l2bc,m,n,iux:iuz)=0.
            enddo
          endif
        enddo
!
!  no profile
!
      case ('nothing')
!
!  no profile matches
!
      case default
        if (lroot) print*,'interior_bc_hydro: No such profile ',interior_bc_hydro_profile
      endselect
!
    endsubroutine interior_bc_hydro
!***********************************************************************
    subroutine impose_profile_diffrot(f,df,prof_diffrot,ldiffrot_test)
!
!  forcing of differential rotation with a -(1/tau)*(u-uref) method
!
!  27-june-2007 dhruba: coded
!
      use Sub, only: step
!
      real, dimension (mx,my,mz,mfarray) :: f
      real, dimension (mx,my,mz,mvar) :: df
      character (len=labellen) :: prof_diffrot
      logical :: ldiffrot_test
!
      real, dimension(nx) :: local_Omega

      select case (prof_diffrot)
!
!  diffrot profile from Brandenburg & Sandin (2004, A&A)
!
      case ('BS04')
        df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-tau_diffrot1*(f(l1:l2,m,n,iuy)-prof_amp1*prof_amp3(n))
!
!  diffrot profile from Brandenburg & Sandin (2004, A&A), modified
!  for convection.
!
      case ('BS04c')
        df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-tau_diffrot1*(f(l1:l2,m,n,iuy)-prof_amp1*prof_amp3(n))
!
!  same as above but with an equator
!
      case ('BS04c1')
        df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-tau_diffrot1*(f(l1:l2,m,n,iuy)-prof_amp1*prof_amp3(n))
!
!  modified diffrot profile from Brandenburg & Sandin (2004, A&A)
!
      case ('BS04m')
        df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tau_diffrot1*(f(l1:l2,m,n,iuz)-prof_amp1*prof_amp4(m))
!
!  Shear profile from Hughes & Proctor (2009, PRL). Force either the
!  full velocity field or only the y-average.
!
      case ('HP09')
      if (.not.lcalc_uumeanxz) then
        !df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)-tau_diffrot1* f(l1:l2,m,n,iux)
        df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-tau_diffrot1*(f(l1:l2,m,n,iuy)-prof_amp1*prof_amp3(n))
      else
        df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-tau_diffrot1*(uumxz(l1:l2,n,2)-prof_amp1*prof_amp3(n))
      endif
!
!  Shear profile linear in x
!
      case ('Sx')
      if (lcalc_uumeanx) then
        df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-tau_diffrot1*(uumx(l1:l2,iuy)-Shearx*x(l1:l2))
      else
        df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-tau_diffrot1*(f(l1:l2,m,n,iuy)-Shearx*x(l1:l2))
      endif
!
!  Solar rotation profile from Dikpati & Charbonneau (1999, ApJ)
!
      case ('solar_DC99')
      if (lcalc_uumeanxy) then 
        df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tau_diffrot1*(uumxy(l1:l2,m,3)-prof_amp1*prof_amp4(m))
      else
        df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tau_diffrot1*(f(l1:l2,m,n,iuz)-prof_amp1*prof_amp4(m))
      endif
!
!  vertical shear profile
!
      case ('vertical_shear')
      if (.not.lcalc_uumean) then
        df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-tau_diffrot1*(f(l1:l2,m,n,iuy)-prof_amp3(n))
      else
        df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-tau_diffrot1*(uumz(n,2)-prof_amp3(n))
      endif
!
!  vertical compression profile
!
      case ('vertical_compression')
      if (.not.lcalc_uumean) then
        df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tau_diffrot1*(f(l1:l2,m,n,iuz)-prof_amp3(n))
      else
        df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tau_diffrot1*(uumz(n,3)-prof_amp3(n))
      endif
!
!  Remove vertical shear profile
!
      case ('remove_vertical_shear')
        f(l1:l2,m,n,iux)=f(l1:l2,m,n,iux)-uumz(n,1)
        f(l1:l2,m,n,iuy)=f(l1:l2,m,n,iuy)-uumz(n,2)
!
!  vertical shear profile
!
      case ('vertical_shear_x')
        df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)-tau_diffrot1*(f(l1:l2,m,n,iux)-prof_amp3(n))
!
!  vertical shear profile with sinz profile
!
      case ('vertical_shear_x_sinz')
        df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)-tau_diffrot1*(f(l1:l2,m,n,iux)-prof_amp3(n))
!
!  Vertical shear profile U_y(z) centred around given z, forcing the
!  horizontally averaged flow.
!
      case ('vertical_shear_z')
      if (.not.lcalc_uumean) then
         df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-tau_diffrot1*(f(l1:l2,m,n,iuy)-prof_amp3(n))
      else
         df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-tau_diffrot1*(uumz(n,2)-prof_amp3(n))
      endif
!
!  Vertical shear profile U_y(z) centred around given z, forcing the
!  y-averaged averaged flow.
!
      case ('vertical_shear_z2')
        df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-tau_diffrot1*(uumxz(l1:l2,n,2)-prof_amp3(n))
!
!  Linear vertical shear profile U_y(z), forcing the y-averaged flow.
!
      case ('vertical_shear_linear')
        df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-tau_diffrot1*(uumxz(l1:l2,n,2)-prof_amp3(n))
!
!  set u_phi=0 below given radius, i.e. enforce a tachocline in
!  spherical convection setup
!
      case ('tachocline')
        df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tau_diffrot1*prof_amp1*f(l1:l2,m,n,iuz)
!
!  write differential rotation in terms of Gegenbauer polynomials
!  Omega = Omega0 + Omega2*P31(costh)/sinth + Omega4*P51(costh)/sinth + ...
!  Note that P31(theta)/sin(theta) = (3/2) * [1 - 5*cos(theta)^2 ]
!
      case ('solar_simple')
      if (lspherical_coords.or.lcartesian_coords) then
        df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tau_diffrot1*(f(l1:l2,m,n,iuz) &
                                                          -prof_amp1*prof_amp4(m))
!            -prof_amp1*cos(20.*x(llx))*cos(20.*y(m)) )
      endif
      if (ldiffrot_test) then
        f(l1:l2,m,n,iux:iuy) = 0.
        if (lspherical_coords.or.lcartesian_coords) f(l1:l2,m,n,iuz) = prof_amp1*prof_amp4(m)
      endif
!
!  radial_uniform_shear
!  uphi = slope*x + uoffset
!
      case ('radial_uniform_shear')
        df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tau_diffrot1*(f(l1:l2,m,n,iuz)-prof_amp1)
!
! vertical shear in uz with respect to uz (slow wind)
!
      case ('breeze')
      if (.not.lcalc_uumean) then
         df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tau_diffrot1*(f(l1:l2,m,n,iuz)-prof_amp3(n))
      else
         df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tau_diffrot1*(uumz(n,3)-prof_amp3(n))
      endif
!
!  uz with respect to z (slow wind) like 'breeze' case but ampl_wind a function of z
!
      case ('slow_wind')
      if (.not.lcalc_uumean) then
         df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tau_diffrot1*(f(l1:l2,m,n,iuz)-prof_amp3(n))
      else
         df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tau_diffrot1*(uumz(n,3)-prof_amp3(n))
      endif
!
!  Radial shear profile
!
      case ('radial_shear')
         df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tau_diffrot1*(uumxy(l1:l2,m,3)-prof_amp1)
!
!  Radial shear profile with damping of other mean velocities
!
      case ('radial_shear_damp')
         df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)-tau_diffrot1*(uumxy(l1:l2,m,1)-0.)
         df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-tau_diffrot1*(uumxy(l1:l2,m,2)-0.)
         df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tau_diffrot1*(uumxy(l1:l2,m,3)-prof_amp1)
!
!  Damp mean velocities in the corona above rdampext
!
      case ('damp_corona')
      if (lspherical_coords) then
        df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)-tau_diffrot1*prof_amp1*(uumxy(l1:l2,m,1)-0.)
        df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-tau_diffrot1*prof_amp1*(uumxy(l1:l2,m,2)-0.)
        df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tau_diffrot1*prof_amp1*(uumxy(l1:l2,m,3)-0.)
      else if (lcartesian_coords) then
        if (.not.lcalc_uumeanz) then
          df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)-tau_diffrot1*prof_amp3(n)*(f(l1:l2,m,n,iux)-0.)
          df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-tau_diffrot1*prof_amp3(n)*(f(l1:l2,m,n,iuy)-0.)
          df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tau_diffrot1*prof_amp3(n)*(f(l1:l2,m,n,iuz)-0.)
        else
          df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)-tau_diffrot1*prof_amp3(n)*(uumz(n,1)-0.)
          df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-tau_diffrot1*prof_amp3(n)*(uumz(n,2)-0.)
          df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tau_diffrot1*prof_amp3(n)*(uumz(n,3)-0.)
        endif
      endif
!
!  Damp horizontal motion
!
      case ('damp_horiz_vel')
        if (lcartesian_coords) then
          df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)-tau_diffrot1*prof_amp3(n)*f(l1:l2,m,n,iux)
          df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-tau_diffrot1*prof_amp3(n)*f(l1:l2,m,n,iuy)
        endif
!
!  Latitudinal shear profile
!
      case ('latitudinal_shear')
         df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tau_diffrot1*(uumxy(l1:l2,m,3)-prof_amp4(m))
!
!  Damp/enforce high latitude jets in spherical coordinates
!
      case ('damp_jets')
         df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tau_diffrot1*prof_amp4(m)*(uumxy(l1:l2,m,3)-uzjet)
!
!  spoke-like-NSSL (analogous to that in hydro_kinematic)
!
      case ('spoke-like-NSSL')
        local_Omega=profx_diffrot1*profy_diffrot1(m)+profx_diffrot2*profy_diffrot2(m)+profx_diffrot3*profy_diffrot3(m)
        df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tau_diffrot1*(uumxy(l1:l2,m,3)-prof_amp1*local_Omega*sinth(m))
!
!  Relax toward (1D-z) profile read from file
!
      case ('uumz_profile')
        df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)-tau_diffrot1*(uumz(n,1)-uumz_prof(n-nghost,1))
        df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)-tau_diffrot1*(uumz(n,2)-uumz_prof(n-nghost,2))
        if (.not.limpose_only_horizontal_uumz) &
           df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tau_diffrot1*(uumz(n,3)-uumz_prof(n-nghost,3))
!
!  Relax toward (2D-xy) profile read from file
!
      case ('omega_profile')
        df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)-tau_diffrot1*(uumxy(l1:l2,m,3)-omega_prof(:,m-nghost)*x(l1:l2)*sinth(m))
!
      case default

      endselect
!
    endsubroutine impose_profile_diffrot
!***********************************************************************
    subroutine read_uumz_profile(uumz_prof)
!
!  Read vertical profiles of horizontally averaged flows from file.
!
!  23-oct-18/pjk: added
!  20-apr-21/MR: use mpiscatter
!
      use Mpicomm, only: mpibcast_real_arr, mpiscatter, &
                         MPI_COMM_ZBEAM, MPI_COMM_XYPLANE
!
      real, dimension(nz,3), intent(out) :: uumz_prof
!
      real, dimension(nzgrid) :: tmp1z, tmp2z, tmp3z
      real :: var1,var2,var3
      logical :: exist
      integer :: stat, n
!
      uumz_prof = 0.

      if (lroot) then
!
!  Read mean velocity (uumz) and write into an array.
!  If file is not found in run directory, search under trim(directory).
!
        inquire(file='uumz.dat',exist=exist)
        if (exist) then
          open(31,file='uumz.dat')
        else
          inquire(file=trim(directory)//'/uumz.ascii',exist=exist)
          if (exist) then
            open(31,file=trim(directory)//'/uumz.ascii')
          else
            call fatal_error('read_uumz_profile','no input file uumz.dat or '//trim(directory)//' uumz.ascii')
          endif
        endif
!
!  Read profiles. Assuming no ghost zones in uumz.dat.
!
        do n=1,nzgrid
          read(31,*,iostat=stat) var1,var2,var3
          if (stat<0) exit      !MR: then data missing!
          if (ip<5) print*,'uxmz, uymz, uzmz: ',var1,var2,var3
          tmp1z(n)=var1
          tmp2z(n)=var2
          tmp3z(n)=var3
        enddo
!
        close(31)

      endif
!
!  Distribute tmp*z along z-beams, then replicate across xy-planes.
!
      if (ipx==0.and.ipy==0) then
        call mpiscatter(tmp1z, uumz_prof(:,1), root, comm=MPI_COMM_ZBEAM)
        call mpiscatter(tmp2z, uumz_prof(:,2), root, comm=MPI_COMM_ZBEAM)
        call mpiscatter(tmp3z, uumz_prof(:,3), root, comm=MPI_COMM_ZBEAM)
      endif
      call mpibcast_real_arr(uumz_prof, 3*nz, proc=0, comm=MPI_COMM_XYPLANE)
!
!print*, 'iproc,uumz_prof=', iproc,uumz_prof(:,1)
!
    endsubroutine read_uumz_profile
!***********************************************************************
    subroutine read_omega_profile(omega_prof)
!
!  Read profile of angular velocity as functio nof x and y from file
!  omega.dat or omega.ascii .
!
!  20-apr-21/MR: coded
!
      use Mpicomm, only: mpibcast_real_arr, mpiscatter, &
                         MPI_COMM_ZBEAM, MPI_COMM_XYPLANE
!
      real, dimension(nx,ny), intent(out) :: omega_prof

      real, dimension(:,:), allocatable :: omega_prof_glob
      logical :: exist
      integer :: stat
!
      omega_prof = 0.
      if (lroot) then
!
!  Read angular velocity omega and write into an array.
!  If file is not found in run directory, search under trim(directory).
!
        inquire(file='omega.dat',exist=exist)
        if (exist) then
          open(31,file='omega.dat')
        else
          inquire(file=trim(directory)//'/omega.ascii',exist=exist)
          if (exist) then
            open(31,file=trim(directory)//'/omega.ascii')
          else
            call fatal_error('read_omega_profile','no input file omega.dat or' &
                             //trim(directory)//' omega.ascii')
          endif
        endif
!
!  Read profile. Assuming no ghost zones in omega.dat.
!
        allocate(omega_prof_glob(nxgrid,nygrid))
        read(31,*,iostat=stat) omega_prof_glob
        close(31)

      endif
!
!  Distribute omega across xy-planes, then replicate along z-beams.
!
      if (ipz==0) &
        call mpiscatter(omega_prof_glob, omega_prof, root, comm=MPI_COMM_XYPLANE)

      call mpibcast_real_arr(omega_prof, nx*ny, proc=0, comm=MPI_COMM_ZBEAM)
!write(iproc+40,'(8(f8.1,1x))') omega_prof

    endsubroutine read_omega_profile
!***********************************************************************
    subroutine impose_velocity_ceiling(f)
!
!  Impose a maximum velocity by setting all higher velocities to the maximum
!  value (velocity_ceiling). Useful for debugging purposes.
!
!  13-aug-2007/anders: implemented.
!
      real, dimension (mx,my,mz,mfarray), intent(inout) :: f
!
      if (velocity_ceiling>0.0) then
        where (f(l1:l2,m,n,iux:iuz)> velocity_ceiling) &
            f(l1:l2,m,n,iux:iuz)= velocity_ceiling
        where (f(l1:l2,m,n,iux:iuz)<-velocity_ceiling) &
            f(l1:l2,m,n,iux:iuz)=-velocity_ceiling
      endif
!
    endsubroutine impose_velocity_ceiling
!***********************************************************************
    subroutine meri_circ(f)
!
! Meridional circulation as initial condition.
!
!  26-apr-2010/dhruba: coded.
!
      real, dimension (mx,my,mz,mfarray), intent(inout) :: f
      integer :: m,n
      real :: rone,theta,theta1
!
      do n=n1,n2
        do m=m1,m2
          rone=xyz0(1)
          theta=y(m)
          theta1=xyz0(2)
!
          f(l1:l2,m,n,iux)=amp_meri_circ*(r1_mn**2)*(sin1th(m))*(&
              2*sin(theta-theta1)*cos(theta-theta1)*cos(theta)&
              -sin(theta)*sin(theta-theta1)**2)*&
              (x(l1:l2)-1.)*(x(l1:l2)-rone)**2
          f(l1:l2,m,n,iuy)=-amp_meri_circ*r1_mn*sin1th(m)*(&
              cos(theta)*sin(theta-theta1)**2)*&
              (x(l1:l2)-rone)*(3*x(l1:l2)-rone-2.)
          f(l1:l2,m,n,iuz)=0.
        enddo
      enddo
!
    endsubroutine  meri_circ
!***********************************************************************
    subroutine hydro_clean_up
!
!  This is a dummy routine.
!
!  8-sep-2009/dhruba: coded
!
      if (ldebug) call warning('hydro_clean_up','Nothing to do for hydro.f90')
!
    endsubroutine hydro_clean_up
!***********************************************************************
    subroutine expand_shands_hydro
!
!  Expands shorthand labels of hydro diagnostics.
!
!  16-may-12/MR: coded
!
      use Diagnostics, only : name_is_present, expand_cname
!
      if (nnamerz>0) then
!
        call expand_cname(cnamerz,nnamerz,name_is_present(cnamerz,'uumphi'),&
                          'urmphi','upmphi','uzmphi')
!
        if (name_is_present(cnamerz,'upmphi')>0) then
          call expand_cname(cnamerz,nnamerz,name_is_present(cnamerz,'uusphmphi'),&
                            'ursphmphi','uthmphi')
        else
          call expand_cname(cnamerz,nnamerz,name_is_present(cnamerz,'uusphmphi'),&
                            'ursphmphi','uthmphi','upmphi')
        endif
      endif
!
    endsubroutine expand_shands_hydro
!***********************************************************************
    subroutine amp_lm(psi,psilm,rselect)

      use Sub, only: ylm

      real,dimension(nx),intent(in):: psi,rselect
      real,dimension(nx,Nmodes_SH),intent(out) :: psilm
      real :: sph_har
      integer :: ell,emm,imode
      real,dimension(nx) :: one_by_rsqr

      one_by_rsqr=1./(x(l1:l2)*x(l1:l2))
      if ((m.eq.1).and.(n.eq.1)) write(*,*) rselect

      do ell=0,lSH_max
        do emm=-ell,ell
          imode=(ell+1)*(ell+1)-ell+emm
          sph_har= ylm(ell,emm)
          psilm(:,imode) = psi*rselect*sph_har*one_by_rsqr
        enddo
      enddo

    endsubroutine amp_lm
!***********************************************************************
    subroutine calc_gradu(f)
!
    use Sub, only : gij
    real, dimension (mx,my,mz,mfarray) :: f
    integer :: imn,jk,jj,kk,nyz
    real, dimension(nx,3,3) :: gradu
!
! Calculates gradu and stores it as an auxiliary. This is expected to be called
! only once either during initialization or post-processing. 
!
    nyz=ny*nz
    do imn=1,nyz
       n=nn(imn)
       m=mm(imn)
       lfirstpoint=(imn==1)      ! true for very first iteration of m-n loop
       llastpoint=(imn==nyz) 
       call gij(f,iuu,gradu,1)
       jk=0
       do jj=1,3; do kk=1,3
         f(l1:l2,m,n,iguij+jk) = gradu(:,jj,kk)
         jk=jk+1
       enddo;enddo
    enddo
!
    endsubroutine calc_gradu
!***********************************************************************
    subroutine pushpars2c(p_par)

    use Syscalls, only: copy_addr

    integer, parameter :: n_pars=1
    integer(KIND=ikind8), dimension(n_pars) :: p_par

    call copy_addr(lpressuregradient_gas,p_par(1))  ! int

    endsubroutine pushpars2c
!***********************************************************************
    subroutine pushdiags2c(p_diag)

    use Syscalls, only: copy_addr
    use Diagnostics, only: set_type

    integer, parameter :: n_diags=12
    integer(KIND=ikind8), dimension(n_diags) :: p_diag

    call copy_addr(idiag_urms,p_diag(1))
    call set_type(idiag_urms,lsqrt=.true.)
    call copy_addr(idiag_uxrms,p_diag(2))
    call set_type(idiag_uxrms,lsqrt=.true.)
    call copy_addr(idiag_uyrms,p_diag(3))
    call set_type(idiag_uyrms,lsqrt=.true.)
    call copy_addr(idiag_uzrms,p_diag(4))
    call set_type(idiag_uzrms,lsqrt=.true.)
    call copy_addr(idiag_umax,p_diag(5))
    call set_type(idiag_umax,lmax=.true.)
    call copy_addr(idiag_umin,p_diag(6))
    call set_type(idiag_umin,lmin=.true.)
    call copy_addr(idiag_uxmin,p_diag(7))
    call set_type(idiag_uxmin,lmin=.true.)
    call copy_addr(idiag_uymin,p_diag(8))
    call set_type(idiag_uymin,lmin=.true.)
    call copy_addr(idiag_uzmin,p_diag(9))
    call set_type(idiag_uzmin,lmin=.true.)
    call copy_addr(idiag_uxmax,p_diag(10))
    call set_type(idiag_uxmax,lmax=.true.)
    call copy_addr(idiag_uymax,p_diag(11))
    call set_type(idiag_uymax,lmax=.true.)
    call copy_addr(idiag_uzmax,p_diag(12))
    call set_type(idiag_uzmax,lmax=.true.)

    endsubroutine pushdiags2c
!***********************************************************************
endmodule Hydro