! $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. ! CPARAM logical, parameter :: lhydro_potential = .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) ! PENCILS PROVIDED lorentz; hless; advec_uu !*************************************************************** ! 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. real :: TG_A=1., TG_B=-1., TG_C=0. real :: vwall=.0, alpha_hless=.0, eps_hless=.0 real :: xjump_mid=0.,yjump_mid=0.,zjump_mid=0. integer :: nb_rings=0 integer :: neddy=0 integer :: iTij=0, ihless=0, jhless=0, nhless=0 real, dimension(:), allocatable :: thless, xhless, yhless, zhless real, dimension(:), allocatable :: Bsquared ! ! 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 :: lvv_as_aux=.false., lvv_as_comaux=.false. logical :: lscale_tobox=.true., lrandom_ampl_uu=.false. logical :: lfactors_uu=.false. logical :: lpower_profile_file_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, lrelativistic_eos_corr logical :: lno_noise_uu=.false., lrho_nonuni_uu=.false. logical :: llorentz_limiter=.false., full_3D=.false. logical :: lhiggsless=.false., lhiggsless_old=.false. logical :: lsqrt_qirro_uu=.false., lset_uz_zero=.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 :: 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., qini=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, lrandom_ampl_uu, & 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, & lvv_as_aux, lvv_as_comaux, & lfactors_uu, qirro_uu, lsqrt_qirro_uu, lset_uz_zero, & lno_noise_uu, lrho_nonuni_uu, lpower_profile_file_uu, & llorentz_limiter, lhiggsless, lhiggsless_old, vwall, alpha_hless, & xjump_mid, yjump_mid, zjump_mid, qini ! ! 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.,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, friction_tdep_toffset=0.0, friction_tdep_tau0=0. real :: t1_ekman=0., t2_ekman=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., Sbaro0=0. 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 :: lhubble_hydro=.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., t_cor=0. character (len=labellen) :: uuprof='nothing', friction_tdep='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=impossible 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_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, ampl_Omega, lcoriolis_xdep, & ekman_friction, friction_tdep, friction_tdep_toffset, friction_tdep_tau0, & t1_ekman, t2_ekman, lhubble_hydro, & ampl_forc, k_forc, w_forc, x_forc, dx_forc, ampl_fcont_uu, Sbaro0, & 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, & lhiggsless, vwall, alpha_hless ! ! 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$ 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=r_{\rm diag}} \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^{1/2}$ integer :: idiag_uyrms=0 ! DIAG_DOC: $\left^{1/2}$ integer :: idiag_uzrms=0 ! DIAG_DOC: $\left^{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$ integer :: idiag_uym=0 ! DIAG_DOC: $\left$ integer :: idiag_uzm=0 ! DIAG_DOC: $\left$ integer :: idiag_uzcx10m=0 ! DIAG_DOC: $\left$ integer :: idiag_uzsx10m=0 ! DIAG_DOC: $\left$ integer :: idiag_uduum=0 ! DIAG_DOC: $\left<\boldsymbol{u}\cdot\boldsymbol{u}\right>$ integer :: idiag_ux2m=0 ! DIAG_DOC: $\left$ integer :: idiag_uy2m=0 ! DIAG_DOC: $\left$ integer :: idiag_uz2m=0 ! DIAG_DOC: $\left$ integer :: idiag_ux3m=0 ! DIAG_DOC: $\left$ integer :: idiag_uy3m=0 ! DIAG_DOC: $\left$ integer :: idiag_uz3m=0 ! DIAG_DOC: $\left$ integer :: idiag_ux4m=0 ! DIAG_DOC: $\left$ integer :: idiag_uy4m=0 ! DIAG_DOC: $\left$ integer :: idiag_uz4m=0 ! DIAG_DOC: $\left$ integer :: idiag_uxuy2m=0 ! DIAG_DOC: $\left$ integer :: idiag_uyuz2m=0 ! DIAG_DOC: $\left$ integer :: idiag_uzux2m=0 ! DIAG_DOC: $\left$ integer :: idiag_T00m=0 ! DIAG_DOC: $\left< T_{00} \right>$ integer :: idiag_Txxm=0 ! DIAG_DOC: $\left< T_{xx} \right>$ integer :: idiag_Tyym=0 ! DIAG_DOC: $\left< T_{yy} \right>$ integer :: idiag_Tzzm=0 ! DIAG_DOC: $\left< T_{zz} \right>$ integer :: idiag_Txym=0 ! DIAG_DOC: $\left< T_{xy} \right>$ integer :: idiag_Tyzm=0 ! DIAG_DOC: $\left< T_{yz} \right>$ integer :: idiag_Tzxm=0 ! DIAG_DOC: $\left< T_{zx} \right>$ integer :: idiag_T0x2m=0 ! DIAG_DOC: $\left< T_{0x}^2 \right>$ integer :: idiag_T0y2m=0 ! DIAG_DOC: $\left< T_{0y}^2 \right>$ integer :: idiag_T0z2m=0 ! DIAG_DOC: $\left< T_{0z}^2 \right>$ integer :: idiag_ux2ccm=0 ! DIAG_DOC: $\left$ integer :: idiag_ux2ssm=0 ! DIAG_DOC: $\left$ integer :: idiag_uy2ccm=0 ! DIAG_DOC: $\left$ integer :: idiag_uy2ssm=0 ! DIAG_DOC: $\left$ integer :: idiag_uxuycsm=0 ! DIAG_DOC: $\left$ integer :: idiag_uxuym=0 ! DIAG_DOC: $\left$ integer :: idiag_uxuzm=0 ! DIAG_DOC: $\left$ integer :: idiag_uyuzm=0 ! DIAG_DOC: $\left$ 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$ integer :: idiag_u1u32m=0 ! DIAG_DOC: $\left$ integer :: idiag_u2u13m=0 ! DIAG_DOC: $\left$ integer :: idiag_u2u31m=0 ! DIAG_DOC: $\left$ integer :: idiag_u3u12m=0 ! DIAG_DOC: $\left$ integer :: idiag_u1u23m=0 ! DIAG_DOC: $\left$ integer :: idiag_urmphi=0 ! PHIAVG_DOC: $\left_\varphi$ ! PHIAVG_DOC: [cyl.\ polar coords ! PHIAVG_DOC: $(\varpi,\varphi,z)$] integer :: idiag_upmphi=0 ! PHIAVG_DOC: $\left_\varphi$ integer :: idiag_uzmphi=0 ! PHIAVG_DOC: $\left_\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_\varphi$ integer :: idiag_up2mphi=0 ! PHIAVG_DOC: $\left_\varphi$ integer :: idiag_uz2mphi=0 ! PHIAVG_DOC: $\left_\varphi$ integer :: idiag_urupmphi=0 ! PHIAVG_DOC: $\left_\varphi$ integer :: idiag_uruzmphi=0 ! PHIAVG_DOC: $\left_\varphi$ integer :: idiag_upuzmphi=0 ! PHIAVG_DOC: $\left_\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_\varphi$ integer :: idiag_uthmphi=0 ! PHIAVG_DOC: $\left_\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>$ (continuous forcing only) 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=r_{\rm diag}} \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_qezxum=0 ! DIAG_DOC: $\left< (\boldsymbol{e_z} \times \mathbf{u}) \cdot \mathbf{q} \right>$ integer :: idiag_quysm=0 ! DIAG_DOC: $\left< \frac{1}{\tau} (u_y^S - u_y) \mathbf{\hat{y}} \cdot \mathbf{q} \right>$ integer :: idiag_jxbrqm=0 ! DIAG_DOC: $\left<(\Jv\times\Bv/\rho)\cdot\mathbf{q}\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_EEK2=0 ! DIAG_DOC: $\left<(\varrho\uv^2/2)^2\right>$ integer :: idiag_EEK3=0 ! DIAG_DOC: $\left<(\varrho\uv^2/2)^3\right>$ integer :: idiag_EEK4=0 ! DIAG_DOC: $\left<(\varrho\uv^2/2)^4\right>$ 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$ integer :: idiag_uyglnrxm=0 ! DIAG_DOC: $\left$ integer :: idiag_uzdivum=0 ! DIAG_DOC: $\left$ integer :: idiag_uxuydivum=0 ! DIAG_DOC: $\left$ 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_uzzrms=0 ! DIAG_DOC: $u_{z,z}^{\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_sld_char_rms=0 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_uxph1mz=0 ! XYAVG_DOC: $\left< u_x \right>_{xy}|_{\rm phase 1}$ integer :: idiag_uxph2mz=0 ! XYAVG_DOC: $\left< u_y \right>_{xy}|_{\rm phase 2}$ integer :: idiag_uxph3mz=0 ! XYAVG_DOC: $\left< u_x \right>_{xy}|_{\rm phase 3}$ integer :: idiag_uyph1mz=0 ! XYAVG_DOC: $\left< u_y \right>_{xy}|_{\rm phase 1}$ integer :: idiag_uyph2mz=0 ! XYAVG_DOC: $\left< u_y \right>_{xy}|_{\rm phase 2}$ integer :: idiag_uyph3mz=0 ! XYAVG_DOC: $\left< u_y \right>_{xy}|_{\rm phase 3}$ integer :: idiag_uzph1mz=0 ! XYAVG_DOC: $\left< u_z \right>_{xy}|_{\rm phase 1}$ integer :: idiag_uzph2mz=0 ! XYAVG_DOC: $\left< u_z \right>_{xy}|_{\rm phase 2}$ integer :: idiag_uzph3mz=0 ! XYAVG_DOC: $\left< u_z \right>_{xy}|_{\rm phase 3}$ integer :: idiag_u2ph1mz=0 ! XYAVG_DOC: $\left< u^2 \right>_{xy}|_{\rm phase 1}$ integer :: idiag_u2ph2mz=0 ! XYAVG_DOC: $\left< u^2 \right>_{xy}|_{\rm phase 2}$ integer :: idiag_u2ph3mz=0 ! XYAVG_DOC: $\left< u^2 \right>_{xy}|_{\rm phase 3}$ integer :: idiag_ux2ph1mz=0 ! XYAVG_DOC: $\left< u_x^2 \right>_{xy}|_{\rm phase 1}$ integer :: idiag_ux2ph2mz=0 ! XYAVG_DOC: $\left< u_x^2 \right>_{xy}|_{\rm phase 2}$ integer :: idiag_ux2ph3mz=0 ! XYAVG_DOC: $\left< u_x^2 \right>_{xy}|_{\rm phase 3}$ integer :: idiag_uy2ph1mz=0 ! XYAVG_DOC: $\left< u_y^2 \right>_{xy}|_{\rm phase 1}$ integer :: idiag_uy2ph2mz=0 ! XYAVG_DOC: $\left< u_y^2 \right>_{xy}|_{\rm phase 2}$ integer :: idiag_uy2ph3mz=0 ! XYAVG_DOC: $\left< u_y^2 \right>_{xy}|_{\rm phase 3}$ integer :: idiag_uz2ph1mz=0 ! XYAVG_DOC: $\left< u_z^2 \right>_{xy}|_{\rm phase 1}$ integer :: idiag_uz2ph2mz=0 ! XYAVG_DOC: $\left< u_z^2 \right>_{xy}|_{\rm phase 2}$ integer :: idiag_uz2ph3mz=0 ! XYAVG_DOC: $\left< u_z^2 \right>_{xy}|_{\rm phase 3}$ 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_{xy}$ integer :: idiag_uy2mz=0 ! XYAVG_DOC: $\left_{xy}$ integer :: idiag_uz2mz=0 ! XYAVG_DOC: $\left_{xy}$ integer :: idiag_ux3mz=0 ! XYAVG_DOC: $\left_{xy}$ integer :: idiag_uy3mz=0 ! XYAVG_DOC: $\left_{xy}$ integer :: idiag_uz3mz=0 ! XYAVG_DOC: $\left_{xy}$ integer :: idiag_ux4mz=0 ! XYAVG_DOC: $\left_{xy}$ integer :: idiag_uy4mz=0 ! XYAVG_DOC: $\left_{xy}$ integer :: idiag_uz4mz=0 ! XYAVG_DOC: $\left_{xy}$ integer :: idiag_uz2upmz=0 ! XYAVG_DOC: $\left_{xy}$ integer :: idiag_uz2downmz=0 ! XYAVG_DOC: $\left_{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_ruxph1mz=0 ! XYAVG_DOC: $\left<\varrho u_x \right>_{xy}|_{\rm phase 1}$ integer :: idiag_ruxph2mz=0 ! XYAVG_DOC: $\left<\varrho u_x \right>_{xy}|_{\rm phase 2}$ integer :: idiag_ruxph3mz=0 ! XYAVG_DOC: $\left<\varrho u_x \right>_{xy}|_{\rm phase 3}$ integer :: idiag_ruyph1mz=0 ! XYAVG_DOC: $\left<\varrho u_y \right>_{xy}|_{\rm phase 1}$ integer :: idiag_ruyph2mz=0 ! XYAVG_DOC: $\left<\varrho u_y \right>_{xy}|_{\rm phase 2}$ integer :: idiag_ruyph3mz=0 ! XYAVG_DOC: $\left<\varrho u_y \right>_{xy}|_{\rm phase 3}$ integer :: idiag_ruzph1mz=0 ! XYAVG_DOC: $\left<\varrho u_z \right>_{xy}|_{\rm phase 1}$ integer :: idiag_ruzph2mz=0 ! XYAVG_DOC: $\left<\varrho u_z \right>_{xy}|_{\rm phase 2}$ integer :: idiag_ruzph3mz=0 ! XYAVG_DOC: $\left<\varrho u_z \right>_{xy}|_{\rm phase 3}$ integer :: idiag_rux2ph1mz=0 ! XYAVG_DOC: $\left<\varrho u_x^2 \right>_{xy}|_{\rm phase 1}$ integer :: idiag_rux2ph2mz=0 ! XYAVG_DOC: $\left<\varrho u_x^2 \right>_{xy}|_{\rm phase 2}$ integer :: idiag_rux2ph3mz=0 ! XYAVG_DOC: $\left<\varrho u_x^2 \right>_{xy}|_{\rm phase 3}$ integer :: idiag_ruy2ph1mz=0 ! XYAVG_DOC: $\left<\varrho u_y^2 \right>_{xy}|_{\rm phase 1}$ integer :: idiag_ruy2ph2mz=0 ! XYAVG_DOC: $\left<\varrho u_y^2 \right>_{xy}|_{\rm phase 2}$ integer :: idiag_ruy2ph3mz=0 ! XYAVG_DOC: $\left<\varrho u_y^2 \right>_{xy}|_{\rm phase 3}$ integer :: idiag_ruz2ph1mz=0 ! XYAVG_DOC: $\left<\varrho u_z^2 \right>_{xy}|_{\rm phase 1}$ integer :: idiag_ruz2ph2mz=0 ! XYAVG_DOC: $\left<\varrho u_z^2 \right>_{xy}|_{\rm phase 2}$ integer :: idiag_ruz2ph3mz=0 ! XYAVG_DOC: $\left<\varrho u_z^2 \right>_{xy}|_{\rm phase 3}$ integer :: idiag_ekinph1mz=0 ! XYAVG_DOC: $\left<{1\over2}\varrho\uv^2\right>_{xy}|_{\rm phase 1}$ integer :: idiag_ekinph2mz=0 ! XYAVG_DOC: $\left<{1\over2}\varrho\uv^2\right>_{xy}|_{\rm phase 2}$ integer :: idiag_ekinph3mz=0 ! XYAVG_DOC: $\left<{1\over2}\varrho\uv^2\right>_{xy}|_{\rm phase 3}$ integer :: idiag_oxph1mz=0 ! XYAVG_DOC: $\left< \omega_x \right>_{xy}|_{\rm phase 1}$ integer :: idiag_oxph2mz=0 ! XYAVG_DOC: $\left< \omega_x \right>_{xy}|_{\rm phase 2}$ integer :: idiag_oxph3mz=0 ! XYAVG_DOC: $\left< \omega_x \right>_{xy}|_{\rm phase 3}$ integer :: idiag_oyph1mz=0 ! XYAVG_DOC: $\left< \omega_y \right>_{xy}|_{\rm phase 1}$ integer :: idiag_oyph2mz=0 ! XYAVG_DOC: $\left< \omega_y \right>_{xy}|_{\rm phase 2}$ integer :: idiag_oyph3mz=0 ! XYAVG_DOC: $\left< \omega_y \right>_{xy}|_{\rm phase 3}$ integer :: idiag_ozph1mz=0 ! XYAVG_DOC: $\left< \omega_z \right>_{xy}|_{\rm phase 1}$ integer :: idiag_ozph2mz=0 ! XYAVG_DOC: $\left< \omega_z \right>_{xy}|_{\rm phase 2}$ integer :: idiag_ozph3mz=0 ! XYAVG_DOC: $\left< \omega_z \right>_{xy}|_{\rm phase 3}$ integer :: idiag_ouph1mz=0 ! XYAVG_DOC: $\left<\boldsymbol{\omega}\cdot\uv\right>_{xy}|_{\rm phase 1}$ integer :: idiag_ouph2mz=0 ! XYAVG_DOC: $\left<\boldsymbol{\omega}\cdot\uv\right>_{xy}|_{\rm phase 2}$ integer :: idiag_ouph3mz=0 ! XYAVG_DOC: $\left<\boldsymbol{\omega}\cdot\uv\right>_{xy}|_{\rm phase 3}$ 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_{xy}$ integer :: idiag_uxuzmz=0 ! XYAVG_DOC: $\left_{xy}$ integer :: idiag_uyuzmz=0 ! XYAVG_DOC: $\left_{xy}$ integer :: idiag_Rxymz=0 ! XYAVG_DOC: $\left_{xy}$ integer :: idiag_Rxyupmz=0 ! XYAVG_DOC: $\left_{xy}$ integer :: idiag_Rxydownmz=0 ! XYAVG_DOC: $\left_{xy}$ integer :: idiag_Rxzmz=0 ! XYAVG_DOC: $\left_{xy}$ integer :: idiag_Rxzupmz=0 ! XYAVG_DOC: $\left_{xy}$ integer :: idiag_Rxzdownmz=0 ! XYAVG_DOC: $\left_{xy}$ integer :: idiag_Ryzmz=0 ! XYAVG_DOC: $\left_{xy}$ integer :: idiag_Ryzupmz=0 ! XYAVG_DOC: $\left_{xy}$ integer :: idiag_Ryzdownmz=0 ! XYAVG_DOC: $\left_{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\left(\rho u_x u_y\right)^2\rangle_{xy}$ integer :: idiag_ruxuz2mz=0 ! XYAVG_DOC: $\langle\left(\rho u_x u_z\right)^2\rangle_{xy}$ integer :: idiag_ruyuz2mz=0 ! XYAVG_DOC: $\langle\left(\rho u_y u_z\right)^2\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_{xy}$ integer :: idiag_uyyuzymz=0 ! XYAVG_DOC: $\left_{xy}$ integer :: idiag_uyzuzzmz=0 ! XYAVG_DOC: $\left_{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_{xy}$ integer :: idiag_acczupmz=0 ! XYAVG_DOC: $\left_{xy+}$ integer :: idiag_acczdownmz=0 ! XYAVG_DOC: $\left_{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_{yz}$ integer :: idiag_uy2mx=0 ! YZAVG_DOC: $\left_{yz}$ integer :: idiag_uz2mx=0 ! YZAVG_DOC: $\left_{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_{yz}$ integer :: idiag_fkinxmx=0 ! YZAVG_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}$ integer :: idiag_ox2mxz=0 ! YAVG_DOC: $\left< \omega_x^2 \right>_{y}$ integer :: idiag_oy2mxz=0 ! YAVG_DOC: $\left< \omega_y^2 \right>_{y}$ integer :: idiag_oz2mxz=0 ! YAVG_DOC: $\left< \omega_z^2 \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_{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_{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_{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_ox2mxy=0 ! ZAVG_DOC: $\left< \omega_x^2 \right>_{z}$ integer :: idiag_oy2mxy=0 ! ZAVG_DOC: $\left< \omega_y^2 \right>_{z}$ integer :: idiag_oz2mxy=0 ! ZAVG_DOC: $\left< \omega_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 integer :: idiag_pradrc2=0 integer :: idiag_frict=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, frict real :: t_vart=0., fade_fact ! 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,3) :: fint,fext real, dimension (nx,ny) :: omega_prof integer :: enum_friction_tdep = 0 integer :: enum_uuprof = 0 integer, dimension(3) :: enum_borderuu = 0 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 ! ! Identify version number (generated automatically by SVN). ! if (lroot) call svn_id( & "$Id$") ! ! 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 . 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 ! ! After a reload, we need to rewrite index.pro, but the auxiliary ! arrays are already allocated and must not be allocated again. ! if (lvv_as_aux .or. lvv_as_comaux) & call register_report_aux('vv', ivv, ivx, ivy, ivz, communicated=lvv_as_comaux) ! ! 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) call register_report_aux('lorentz', ilorentz,communicated=.true.) 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 ! ! Define the Higgsless field ! if (lhiggsless) call farray_register_auxiliary('hless',ihless,communicated=.true.) ! ! 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 ! ! 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 ! ! 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 ! ! shared variable of lconservative for density ! call put_shared_variable('lconservative',lconservative) call put_shared_variable('lhiggsless',lhiggsless) call put_shared_variable('lrelativistic',lrelativistic) call put_shared_variable ('tdamp', tdamp) call put_shared_variable ('ldamp_fade', ldamp_fade) call put_shared_variable ('tfade_start', tfade_start) ! 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) if (lviscosity) call put_shared_variable ('lcalc_uuavg',lcalc_uuavg) if (lhiggsless) then eps_hless = alpha_hless/(1.+alpha_hless) call put_shared_variable ('eps_hless',eps_hless,caller='register_hydro') endif ! ! 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 Mpicomm, only: mpibcast 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 logical :: lvectorpotential=.false. ! ! set the right point in profile to unity. ! profile_SH(index_rSH)=dx_1(index_rSH) if (ulev/=impossible) cdtf=ulev ! ! 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) 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, & lpower_profile_file=lpower_profile_file_uu, qirro=qirro_uu, & lsqrt_qirro=lsqrt_qirro_uu, lreinit=lreinitialize_uu, & lrho_nonuni=lrho_nonuni_uu,ilnr=ilnrho, lrandom_ampl=lrandom_ampl_uu) 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', 'set tfade_start < tdamp') 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 ! ! 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 (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. call information('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 ! select case (borderuu(j)) case ('zero','0','constant','initial-condition') call request_border_driving(borderuu(j)) case ('nothing') if (lroot.and.ip<=5) print*,"initialize_hydro: borderuu='nothing'" case default call fatal_error('initialize_hydro','no such borderuu: '//trim(borderuu(j))) end select enddo ! ! Hand over Coriolis force to Particles_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 if (lrun) lcoriolis_force = lcoriolis_force .and. Omega/=0. ! 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 ! ! 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 ! ! 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 not_implemented('initialize_hydro','calculation of z average for Yin-Yang grid') !call initialize_zaver_yy(myl,nycap) endif allocate(uumxy(mx,my,3)) allocate(ruumxy(mx,my,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 not_implemented("initialize_hydro", & "uuprof='solar_simple' 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 prof_amp3=0.5*(tanh((z-rdampext)/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 call fatal_error("initialize_hydro","no such 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) ! ! Warn if orms is not set in print.in ! if (othresh_per_orms/=0..and.idiag_orms==0) then call warning('initialize_hydro','need to set orms in print.in to get othresh. Disabled othresh') othresh_per_orms=0. 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. ! alberto: what does the last sentence mean? lrelativistic_eos is always ! relevant ! if (ldensity) then call get_shared_variable('lrelativistic_eos', lrelativistic_eos) call get_shared_variable('lrelativistic_eos_corr', lrelativistic_eos_corr) else allocate(lrelativistic_eos) lrelativistic_eos=.false. endif ! if (ltime_integrals) then if (.not.(ltime_integrals_always .or. dtcor<=0.)) call put_shared_variable('t_cor',t_cor) if (lvart_in_shear_frame) call fatal_error('initialize_hydro', & 'lvart_in_shear_frame no longer supported.'//achar(10)//'uut etc. are always'// & ' in lab frame. lshear_frame_correlation=T now transforms both uu and uut') endif if (lfargo_advection.and..not.lfargoadvection_as_shift) & call not_implemented("initialize_hydro","Fargo advection without Fourier shift") ! ! Allocate Lorentz gamma squared as part of auxiliary f-array. ! In the magnetic case, also define Bsquared, if needed and get B_ext2 from magnetic module. ! if (lconservative) then f(:,:,:,iTij:iTij+5)=0. if (llorentz_as_aux) f(:,:,:,ilorentz)=0. if (lmagnetic) then if (ibx==0) call fatal_error("initialize_hydro","must use lbb_as_comaux=T for lconservative=T") if (allocated(Bsquared)) deallocate(Bsquared) allocate(Bsquared(mx)) call get_shared_variable('B_ext2',B_ext2) endif endif ! ! Allocate Higgsless field ! if (lhiggsless) then if (allocated(thless)) deallocate(thless, xhless, yhless, zhless) if (lroot) then open(1,file='higgsless.dat') read(1,*) nhless endif call mpibcast(nhless) allocate(thless(nhless), xhless(nhless), yhless(nhless), zhless(nhless)) if (lroot) then do jhless=1,nhless read(1,*) thless(jhless), xhless(jhless), yhless(jhless), zhless(jhless) enddo close(1) if (ip<14) print*,'initialize_hydro: nhless=',nhless endif call mpibcast(thless,nhless) call mpibcast(xhless,nhless) call mpibcast(yhless,nhless) call mpibcast(zhless,nhless) endif 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. 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+sum(rux) ruym=ruym+sum(ruy) ruzm=ruzm+sum(ruz) enddo enddo ! ! communicate to the other processors ! fact=1./nwgrid fsum_tmp(1)=ruxm*fact fsum_tmp(2)=ruym*fact fsum_tmp(3)=ruzm*fact 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 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 use SharedVariables, only: get_shared_variable ! 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, delx, tau_hless 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 real :: dely, delz integer :: j,i,l,ixy,ix,iy,iz,iz0,iyz,iter,niter=100 logical :: lvectorpotential=.false. ! real, dimension(:), pointer :: beta_glnrho_scaled ! ! inituu corresponds to different initializations of uu (called from start). ! call get_shared_variable('beta_glnrho_scaled',beta_glnrho_scaled,caller='init_uu') 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,xjump_mid,yjump_mid,zjump_mid,'x') call jump(f,iuy,uy_left,uy_right,widthuu,xjump_mid,yjump_mid,zjump_mid,'x') case ('gaussian-x'); call gaussian(ampluu(j),f,iuu,kx=kx_uu) 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 ('TG') if (headtt) print*,'Taylor-Green vortex' f(:,:,:,iux:iuz) = 0.0 ! uu call sinx_cosy_cosz(ampluu(j)*TG_A,f,iux,kx_uu,ky_uu,kz_uu) call cosx_siny_cosz(ampluu(j)*TG_B,f,iuy,kx_uu,ky_uu,kz_uu) call sinx_siny_cosz(ampluu(j)*TG_C,f,iuz,kx_uu,ky_uu,kz_uu) if(abs(TG_A*kx_uu + TG_B*ky_uu + TG_C*kz_uu) > tini) then call fatal_error("init_uu", "For Taylor-Green Vortex TG_A*kx_uu + TG_B*ky_uu + TG_C*kz_uu has to be zero!") endif ! case ('potential') if (headtt) print*,'potential flow' ! uu do n=n1,n2; do m=m1,m2 f(l1:l2,m,n,iux)=-ampluu(j)*sin(kx_uu*x(l1:l2))*cos(ky_uu*y(m))*cos(kz_uu*z(n)) f(l1:l2,m,n,iuy)=-ampluu(j)*cos(kx_uu*x(l1:l2))*sin(ky_uu*y(m))*cos(kz_uu*z(n)) f(l1:l2,m,n,iuz)=-ampluu(j)*cos(kx_uu*x(l1:l2))*cos(ky_uu*y(m))*sin(kz_uu*z(n)) 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_x') ! ! Double shear layer (x-dependence) ! if (lroot) print*,'init_uu: Double shear layer (x-dependence)' der=2./delta_u prof=ampluu(j)*(tanh(der*(x(l1:l2)+widthuu))- & tanh(der*(x(l1:l2)-widthuu)))/2. do n=n1,n2 do m=m1,m2 f(l1:l2,m,n,iuy)=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) = f(l,m,n1:n2,iux) + ampluu(j)*exp(-z(n1:n2)**2/widthuu**2) enddo; enddo ! case ('gauss-z-z') if (lroot) print*,'init_uu: gauss-z-z, widthuu, ampluu=', widthuu, ampluu(j) do l=l1,l2; do m=m1,m2 !f(l,m,n1:n2,iuz) = f(l,m,n1:n2,iuz) + ampluu(j)*exp(-z(n1:n2)**2/widthuu**2) f(l,m,1:mz,iuz) = f(l,m,1:mz,iuz) + ampluu(j)*exp(-z**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 if (lspherical_coords) then 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)**(1.-qini)*sinth(m) enddo enddo elseif (lcylindrical_coords) then f(:,:,:,iux) = 0 do n=n1,n2 do m=m1,m2 f(l1:l2,m,n,iuy) = omega_ini*x(l1:l2)**(1.-qini) enddo enddo f(:,:,:,iuz) = 0 else !call fatal_error("init_uu","coord_system should be spherical or cylindric") f(:,:,:,iux) = 0 do n=n1,n2 do m=m1,m2 f(l1:l2,m,n,iuy) = omega_ini*x(l1:l2)**(1.-qini) enddo enddo f(:,:,:,iuz) = 0 endif ! 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, & lpower_profile_file=lpower_profile_file_uu, qirro=qirro_uu, & lsqrt_qirro=lsqrt_qirro_uu,lrho_nonuni=lrho_nonuni_uu,ilnr=ilnrho, & lrandom_ampl=lrandom_ampl_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 ! ! rigid rotation within a sphere ! 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 call fatal_error("init_uu","No such 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=iux,iuz 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 ! ! In 2-D with nzgrid=1, setting uz=0 makes sense, but shouldn't ! be compulsory, so allow for this possibility in 2-D. ! This has been implemented in analogy to lset_AxAy_zero in magnetic. ! if (lset_uz_zero) then if (nzgrid==1) then f(:,:,:,iuz)=0.0 else call fatal_error("init_uu","lset_uz_zero=T only allowed with nzgrid=1") endif endif ! ! Initialize auxiliaries to zero. ! if (lconservative) then ! ! Initialize Higgsless field ! if (lhiggsless) then eps_hless = alpha_hless/(1.+alpha_hless) if (lhiggsless_old) then f(:,:,:,ihless) = eps_hless else f(:,:,:,ihless)=huge1 do jhless=1,nhless do n=1,mz do m=1,my ! delx=2.*atan(tan(.5*(x -xhless(jhless)))) ! dely=2.*atan(tan(.5*(y(m)-yhless(jhless)))) ! delz=2.*atan(tan(.5*(z(n)-zhless(jhless)))) delx=(Lxyz(1)/pi)*atan(tan(pi/Lxyz(1)*(x -vwall*xhless(jhless)))) dely=(Lxyz(2)/pi)*atan(tan(pi/Lxyz(2)*(y(m)-vwall*yhless(jhless)))) delz=(Lxyz(3)/pi)*atan(tan(pi/Lxyz(3)*(z(n)-vwall*zhless(jhless)))) tau_hless=thless(jhless)+sqrt(delx**2+dely**2+delz**2)/vwall where(tau_hless. ! 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, . ! ! 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. ! call integrate_mn_name(p%ou,idiag_ou_int) call sum_mn_name(p%ou,idiag_oum) call sum_mn_name(p%oxu(:,1),idiag_oxum) if (idiag_ourms/=0) call sum_mn_name(p%ou**2,idiag_ourms,lsqrt=.true.) 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 ! ! ! if (idiag_odel2um/=0) then call dot(p%oo,p%del2u,odel2um) call sum_mn_name(odel2um,idiag_odel2um) endif ! ! various vorticity diagnostics ! call max_mn_name(p%o2,idiag_omax,lsqrt=.true.) 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 ! ! ! if (idiag_qom/=0) then call dot(p%curlo,p%oo,qo) call sum_mn_name(qo,idiag_qom) endif ! ! ! 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 if (idiag_qezxum/=0) then call sum_mn_name( -p%curlo(:,1)*p%uu(:,2) + p%curlo(:,2)*p%uu(:,1),idiag_qezxum) endif if (idiag_quysm/=0) then !call sum_mn_name( tau_diffrot1*(prof_amp3(n)-p%uu(:,2))*p%curlo(:,2),idiag_quysm) call sum_mn_name(-kz_diffrot*ampl1_diffrot* & sin(kz_diffrot*(z(n)-xyz0(3))-phase_diffrot)*p%uu(:,3)*p%curlo(:,2),idiag_quysm) 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=- ! alp22=- ! alp33=- ! For fully periodic domains it is sufficient to compute, e.g., only: ! alp11=, alp22=, alp33= ! 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) call max_mn_name(uu_average_cyl(l1:l2,n)*rcyl_mn1*dy_1(m),idiag_nshift,l_dt=.true.) 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) call max_mn_name(uu_average_sph(l1:l2,m)*rcyl_mn1*dz_1(n),idiag_nshift,l_dt=.true.) endif endif if (othresh_per_orms/=0.) call vecout(41,trim(directory)//'/ovec',p%oo,othresh,novec) if ((tdamp/=0.or.dampuext/=0.or.dampuint/=0).and.lOmega_int) then if (idiag_fextm/=0) call sum_mn_name(sum(f(l1:l2,m,n,iux:iuz)*fext,2),idiag_fextm) if (dampuint > 0.) then if (idiag_fintm/=0) call sum_mn_name(sum(f(l1:l2,m,n,iux:iuz)*fint,2),idiag_fintm) endif endif if (ekman_friction/=0) call sum_mn_name(frict,idiag_frict) 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_ux3mz/=0) call xysum_mn_name_z(p%uu(:,1)**3,idiag_ux3mz) if (idiag_uy3mz/=0) call xysum_mn_name_z(p%uu(:,2)**3,idiag_uy3mz) if (idiag_uz3mz/=0) call xysum_mn_name_z(p%uu(:,3)**3,idiag_uz3mz) if (idiag_ux4mz/=0) call xysum_mn_name_z(p%uu(:,1)**4,idiag_ux4mz) if (idiag_uy4mz/=0) call xysum_mn_name_z(p%uu(:,2)**4,idiag_uy4mz) if (idiag_uz4mz/=0) call xysum_mn_name_z(p%uu(:,3)**4,idiag_uz4mz) 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_ekinph1mz/=0) call xysum_mn_name_z(p%ekin,idiag_ekinph1mz,MASK=(p%ss <=ssmask1)) if (idiag_ekinph2mz/=0) call xysum_mn_name_z(p%ekin,idiag_ekinph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2)) if (idiag_ekinph3mz/=0) call xysum_mn_name_z(p%ekin,idiag_ekinph3mz,MASK=(p%ss > ssmask2)) if (idiag_ouph1mz/=0) call xysum_mn_name_z(p%ou,idiag_ouph1mz,MASK=(p%ss <=ssmask1)) if (idiag_ouph2mz/=0) call xysum_mn_name_z(p%ou,idiag_ouph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2)) if (idiag_ouph3mz/=0) call xysum_mn_name_z(p%ou,idiag_ouph3mz,MASK=(p%ss > ssmask2)) if (idiag_uxph1mz/=0) call xysum_mn_name_z(p%uu(:,1),idiag_uxph1mz,MASK=(p%ss <=ssmask1)) if (idiag_uxph2mz/=0) call xysum_mn_name_z(p%uu(:,1),idiag_uxph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2)) if (idiag_uxph3mz/=0) call xysum_mn_name_z(p%uu(:,1),idiag_uxph3mz,MASK=(p%ss > ssmask2)) if (idiag_uyph1mz/=0) call xysum_mn_name_z(p%uu(:,2),idiag_uyph1mz,MASK=(p%ss <=ssmask1)) if (idiag_uyph2mz/=0) call xysum_mn_name_z(p%uu(:,2),idiag_uyph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2)) if (idiag_uyph3mz/=0) call xysum_mn_name_z(p%uu(:,2),idiag_uyph3mz,MASK=(p%ss > ssmask2)) if (idiag_uzph1mz/=0) call xysum_mn_name_z(p%uu(:,3),idiag_uzph1mz,MASK=(p%ss <=ssmask1)) if (idiag_uzph2mz/=0) call xysum_mn_name_z(p%uu(:,3),idiag_uzph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2)) if (idiag_uzph3mz/=0) call xysum_mn_name_z(p%uu(:,3),idiag_uzph3mz,MASK=(p%ss > ssmask2)) if (idiag_u2ph1mz/=0) call xysum_mn_name_z(p%u2,idiag_u2ph1mz,MASK=(p%ss <=ssmask1)) if (idiag_u2ph2mz/=0) call xysum_mn_name_z(p%u2,idiag_u2ph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2)) if (idiag_u2ph3mz/=0) call xysum_mn_name_z(p%u2,idiag_uzph3mz,MASK=(p%ss > ssmask2)) if (idiag_ux2ph1mz/=0) call xysum_mn_name_z(p%uu(:,1)**2,idiag_ux2ph1mz,MASK=(p%ss <=ssmask1)) if (idiag_ux2ph2mz/=0) call xysum_mn_name_z(p%uu(:,1)**2,idiag_ux2ph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2)) if (idiag_ux2ph3mz/=0) call xysum_mn_name_z(p%uu(:,1)**2,idiag_ux2ph3mz,MASK=(p%ss > ssmask2)) if (idiag_uy2ph1mz/=0) call xysum_mn_name_z(p%uu(:,2)**2,idiag_uy2ph1mz,MASK=(p%ss <=ssmask1)) if (idiag_uy2ph2mz/=0) call xysum_mn_name_z(p%uu(:,2)**2,idiag_uy2ph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2)) if (idiag_uy2ph3mz/=0) call xysum_mn_name_z(p%uu(:,2)**2,idiag_uy2ph3mz,MASK=(p%ss > ssmask2)) if (idiag_uz2ph1mz/=0) call xysum_mn_name_z(p%uu(:,3)**2,idiag_uz2ph1mz,MASK=(p%ss <=ssmask1)) if (idiag_uz2ph2mz/=0) call xysum_mn_name_z(p%uu(:,3)**2,idiag_uz2ph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2)) if (idiag_uz2ph3mz/=0) call xysum_mn_name_z(p%uu(:,3)**2,idiag_uz2ph3mz,MASK=(p%ss > ssmask2)) if (idiag_ruxph1mz/=0) call xysum_mn_name_z(p%rho*p%uu(:,1),idiag_ruxph1mz,MASK=(p%ss <=ssmask1)) if (idiag_ruxph2mz/=0) call xysum_mn_name_z(p%rho*p%uu(:,1),idiag_ruxph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2)) if (idiag_ruxph3mz/=0) call xysum_mn_name_z(p%rho*p%uu(:,1),idiag_ruxph3mz,MASK=(p%ss > ssmask2)) if (idiag_ruyph1mz/=0) call xysum_mn_name_z(p%rho*p%uu(:,2),idiag_ruyph1mz,MASK=(p%ss <=ssmask1)) if (idiag_ruyph2mz/=0) call xysum_mn_name_z(p%rho*p%uu(:,2),idiag_ruyph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2)) if (idiag_ruyph3mz/=0) call xysum_mn_name_z(p%rho*p%uu(:,2),idiag_ruyph3mz,MASK=(p%ss > ssmask2)) if (idiag_ruzph1mz/=0) call xysum_mn_name_z(p%rho*p%uu(:,3),idiag_ruzph1mz,MASK=(p%ss <=ssmask1)) if (idiag_ruzph2mz/=0) call xysum_mn_name_z(p%rho*p%uu(:,3),idiag_ruzph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2)) if (idiag_ruzph3mz/=0) call xysum_mn_name_z(p%rho*p%uu(:,3),idiag_ruzph3mz,MASK=(p%ss > ssmask2)) if (idiag_rux2ph1mz/=0) call xysum_mn_name_z(p%rho*p%uu(:,1)**2,idiag_rux2ph1mz,MASK=(p%ss <=ssmask1)) if (idiag_rux2ph2mz/=0) call xysum_mn_name_z(p%rho*p%uu(:,1)**2,idiag_rux2ph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2)) if (idiag_rux2ph3mz/=0) call xysum_mn_name_z(p%rho*p%uu(:,1)**2,idiag_rux2ph3mz,MASK=(p%ss > ssmask2)) if (idiag_ruy2ph1mz/=0) call xysum_mn_name_z(p%rho*p%uu(:,2)**2,idiag_ruy2ph1mz,MASK=(p%ss <=ssmask1)) if (idiag_ruy2ph2mz/=0) call xysum_mn_name_z(p%rho*p%uu(:,2)**2,idiag_ruy2ph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2)) if (idiag_ruy2ph3mz/=0) call xysum_mn_name_z(p%rho*p%uu(:,2)**2,idiag_ruy2ph3mz,MASK=(p%ss > ssmask2)) if (idiag_ruz2ph1mz/=0) call xysum_mn_name_z(p%rho*p%uu(:,3)**2,idiag_ruz2ph1mz,MASK=(p%ss <=ssmask1)) if (idiag_ruz2ph2mz/=0) call xysum_mn_name_z(p%rho*p%uu(:,3)**2,idiag_ruz2ph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2)) if (idiag_ruz2ph3mz/=0) call xysum_mn_name_z(p%rho*p%uu(:,3)**2,idiag_ruz2ph3mz,MASK=(p%ss > ssmask2)) if (idiag_oxph1mz/=0) call xysum_mn_name_z(p%oo(:,1),idiag_oxph1mz,MASK=(p%ss <=ssmask1)) if (idiag_oxph2mz/=0) call xysum_mn_name_z(p%oo(:,1),idiag_oxph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2)) if (idiag_oxph3mz/=0) call xysum_mn_name_z(p%oo(:,1),idiag_oxph3mz,MASK=(p%ss > ssmask2)) if (idiag_oyph1mz/=0) call xysum_mn_name_z(p%oo(:,2),idiag_oyph1mz,MASK=(p%ss <=ssmask1)) if (idiag_oyph2mz/=0) call xysum_mn_name_z(p%oo(:,2),idiag_oyph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2)) if (idiag_oyph3mz/=0) call xysum_mn_name_z(p%oo(:,2),idiag_oyph3mz,MASK=(p%ss > ssmask2)) if (idiag_ozph1mz/=0) call xysum_mn_name_z(p%oo(:,3),idiag_ozph1mz,MASK=(p%ss <=ssmask1)) if (idiag_ozph2mz/=0) call xysum_mn_name_z(p%oo(:,3),idiag_ozph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2)) if (idiag_ozph3mz/=0) call xysum_mn_name_z(p%oo(:,3),idiag_ozph3mz,MASK=(p%ss > ssmask2)) ! 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) 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) 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 ysum_mn_name_xz(p%oo(:,1)**2,idiag_ox2mxz) call ysum_mn_name_xz(p%oo(:,2)**2,idiag_oy2mxz) call ysum_mn_name_xz(p%oo(:,3)**2,idiag_oz2mxz) ! 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) if (idiag_uy2mxy/=0) call zsum_mn_name_xy(p%uu,idiag_uy2mxy,(/0,2,0/)) if (idiag_uz2mxy/=0) call zsum_mn_name_xy(p%uu,idiag_uz2mxy,(/0,0,2/)) if (idiag_ox2mxy/=0) call zsum_mn_name_xy(p%oo(:,1)**2,idiag_ox2mxy) if (idiag_oy2mxy/=0) call zsum_mn_name_xy(p%oo,idiag_oy2mxy,(/0,2,0/)) if (idiag_oz2mxy/=0) call zsum_mn_name_xy(p%oo,idiag_oz2mxy,(/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 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) endif if (lSGS_hydro) call calc_diagnostics_SGS_hydro(p) 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 if (idiag_uduum/=0) then uduu=sum(p%uu*df(l1:l2,m,n,iux:iuz),2) ! = dot product 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 ! 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. ! real, dimension (mx,my,mz,mfarray) :: f type (pencil_case) :: p ! intent(inout) :: f intent(in) :: p ! real :: fact_cos,fact_sin logical :: lreset_vart ! lreset_vart=.false. if (ltime_integrals_always .or. dtcor<=0.) then if (it==1) lreset_vart=.true. else if (t>t_vart) lreset_vart=.true. endif ! ! assign values to uut etc. ! reset uut etc. if lreset_vart=.true. ! 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 fact_cos=cos(omega_fourier*t) fact_sin=sin(omega_fourier*t) ! 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 (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 ! endsubroutine time_integrals_hydro !*********************************************************************** subroutine update_for_time_integrals_hydro ! if (.not.(ltime_integrals_always .or. dtcor<=0.)) then if (t>t_vart) then t_cor=t ! ! If uut and oot are updated, write t to file and advance t_var after leaving the mn-loop. ! 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 endsubroutine update_for_time_integrals_hydro !*********************************************************************** subroutine hydro_after_boundary(f) ! ! Calculate and 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 , 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, vecout_initialize, dot2_mx, dot2 use EquationOfState, only: cs20 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, 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=1. real, dimension (mx) :: delx real :: dely, delz real :: c,s,sinalp,cosalp,OO2,alpha_precession_rad real :: cs201=1., cs2011 integer :: iter_relB integer :: i,j,l ! ! In the conservative case, we calculate the Lorentz gamma squared and Tij here, ! rather than in before_boundary, because the B-field is unknown otherwise. ! 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 (lrelativistic_eos) cs201=1.+cs20 cs2011=1./cs201 if (lconservative) then if (iTij==0) call fatal_error("hydro_after_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 (ibx==0) call fatal_error("hydro_after_boundary","must use lbb_as_comaux=T") call dot2(f(:,m,n,ibx:ibz),Bsquared) if (m==4.and.n==4) then print*,'AXEL: after hydro: bb(:,1)=', f(:,4,4,ibx) print*,'AXEL: Bsquared=',m,n,Bsquared(:) endif 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 ! ! Higgsless field ! if (lhiggsless) then if (lhiggsless_old) then do jhless=1,nhless delx=2.*atan(tan(.5*(x -xhless(jhless)))) dely=2.*atan(tan(.5*(y(m)-yhless(jhless)))) delz=2.*atan(tan(.5*(z(n)-zhless(jhless)))) where(sqrt(delx**2+dely**2+delz**2) & < vwall*(max(real(t)-thless(jhless),.0))) f(:,m,n,ihless)=0. hydro_energy=hydro_energy-f(:,m,n,ihless) enddo else where(real(t) < f(:,m,n,ihless)) hydro_energy=hydro_energy-alpha_hless/(1.+alpha_hless) endif 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=1./(1.-rat) if (lrelativistic_eos) & lorentz_gamma2=lorentz_gamma2*(.5-rat*cs20*cs2011 + & sqrt(.25-rat*cs20*cs2011**2)) !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 !if (iproc==1.and.m==m1.and.n==n1) print*,'AXEL: rho_gam2(80:160)=',t,rho_gam2(80:160) ! ! At the end, we put lorentz_gamma2 into the f array. ! if (ilorentz /= 0) f(:,m,n,ilorentz)=lorentz_gamma2 if (lhiggsless) then if (lhiggsless_old) then press=rho*cs20-f(:,m,n,ihless) else press=rho*cs20 where(real(t) < f(:,m,n,ihless)) press=press-alpha_hless/(1.+alpha_hless) endif else press=rho*cs20 endif ! ! Now set the nonmagnetic stresses; begin with the diagonal components: ! Tii=(Ti0)^2/rho or Tii=(Ti0)^2/(4./3.*rho*gamma^2) ! !if (iproc==1.and.m==m1.and.n==n1) print*,'AXEL: f(80:160,m,n,irho)=',t,f(80:160,m,n,irho) !if (iproc==1.and.m==m1.and.n==n1) print*,'AXEL: f(80:160,m,n,iuu)=',t,f(80:160,m,n,iuu) 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) ! ! compute velocity, if as comaux ! if (lvv_as_aux .or. lvv_as_comaux) then do j=0,2 f(:,m,n,ivv+j)=rho_gam21*f(:,m,n,iuu+j) enddo endif ! ! 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 ! ! 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) ! PC: The line commented below is for damping box modes of convection. ! if (z(n) .lt. 0.0) f(:,:,n,iuu+j-1) = f(:,:,n,iuu+j-1)-rescale_uu*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 _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 _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) ! if (ldiagnos.and.othresh_per_orms/=0) call vecout_initialize(41,trim(directory)//'/ovec',novec) ! ! Prepare damping motions in some regions for some time spans if desired. ! if (tdamp/=0.or.dampuext/=0.or.dampuint/=0) call update_fade_fact 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 ju=j+iuu-1 select case (borderuu(j)) ! case ('nothing'); case ('zero','0') f_target(:,j)=0. call border_driving(f,df,p,f_target(:,j),ju) ! case ('constant') f_target(:,j) = uu_const(j) call border_driving(f,df,p,f_target(:,j),ju) ! case ('initial-condition') call set_border_initcond(f,ju,f_target(:,j)) call border_driving(f,df,p,f_target(:,j),ju) ! endselect ! 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 use Mpicomm, only: mpibcast_real, MPI_COMM_WORLD real :: orms ! ! fetch orms (this requires that orms is set in print.in) ! broadcast result to other processors ! if (lroot) orms=fname(idiag_orms) call mpibcast_real(orms,comm=MPI_COMM_WORLD) ! ! 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 !MR: but are not persistent, right? ! if (novec>novecmax) 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 ! 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) print*, 'precession: omega_precession=', omega_precession ! ! matrix multiply ! do j=1,3 df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux) + mat_cent(1,j)*p%rr(:,j) + mat_cori(1,j)*p%uu(:,j) df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy) + mat_cent(2,j)*p%rr(:,j) + mat_cori(2,j)*p%uu(:,j) df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz) + mat_cent(3,j)*p%rr(:,j) + mat_cori(3,j)*p%uu(:,j) 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. .and. 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 not_implemented("coriolis_cartesian","if Omega has 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*dtor) s2=-2*Omega*sin(theta*dtor) ! 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.0 .and. 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 not_implemented("coriolis_spherical","for Omega not 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 not_implemented("coriolis_spherical","Centrifugal force for Omega at an angle 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 not_implemented("coriolis_spherical_del2p","for Omega at an angle with 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 not_implemented("coriolis_spherical_del2p","Centrifugal force 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 not_implemented("coriolis_cylindrical","for angular velocity 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 not_implemented("coriolis_cylindrical_del2p","for angular velocity at an angle with 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 update_fade_fact real, save :: last_t = -1.0 real :: tau ! ! damp motion during time interval 00) or |dampu|/dt (if dampu <0). ! With ldamp_fade=T, damping coefficient is smoothly fading out ! if ((dampu /= 0.) .and. (t < tdamp)) then ! if (headtt) then ! ! inform about the damping term ! if (ldamp_fade) then print*, 'update_fade_fact: Damping velocities until time ', tdamp print*, 'update_fade_fact: with a smooth fade starting at ', tfade_start else print*, 'update_fade_fact: Damping velocities constantly until time ', tdamp endif endif 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("update_fade_fact","tau is invalid as > 0.5)") endif endif endif endif endsubroutine update_fade_fact !*********************************************************************** 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 integer :: i,j ! ! 1. damp motion during time interval 00) or |dampu|/dt (if dampu <0). ! With ldamp_fade=T, damping coefficient is smoothly fading out ! if ((dampu /= 0.) .and. (t < tdamp)) then 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) enddo df(l1:l2,m,n,iux:iuz)=df(l1:l2,m,n,iux:iuz)+fext ! ! 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:iuz)=df(l1:l2,m,n,iux:iuz)+fint 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 ! 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_T00m=0 idiag_Txxm=0 idiag_Tyym=0 idiag_Tzzm=0 idiag_Txym=0 idiag_Tyzm=0 idiag_Tzxm=0 idiag_T0x2m=0 idiag_T0y2m=0 idiag_T0z2m=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_ux3mz=0 idiag_uy3mz=0 idiag_uz3mz=0 idiag_ux4mz=0 idiag_uy4mz=0 idiag_uz4mz=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_uymz=0 idiag_uymz=0 idiag_uymz=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_ox2mxz=0 idiag_oy2mxz=0 idiag_oz2mxz=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_ox2mxy=0 idiag_oy2mxy=0 idiag_oz2mxy=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_qezxum=0 idiag_quysm=0 idiag_jxbrqm=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_uzzrms=0 idiag_uxzrms=0 idiag_uyzrms=0 idiag_uzyrms=0 idiag_duxdzma=0 idiag_duydzma=0 idiag_EEK=0 idiag_EEK2=0 idiag_EEK3=0 idiag_EEK4=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 idiag_frict=0; idiag_pradrc2=0 ivid_oo=0; ivid_o2=0; ivid_ou=0; ivid_divu=0; ivid_u2=0; ivid_Ma2=0; ivid_uu_sph=0 idiag_ruxph1mz=0 idiag_ruxph2mz=0 idiag_ruxph3mz=0 idiag_ruyph1mz=0 idiag_ruyph2mz=0 idiag_ruyph3mz=0 idiag_ruzph1mz=0 idiag_ruzph2mz=0 idiag_ruzph3mz=0 idiag_rux2ph1mz=0 idiag_rux2ph2mz=0 idiag_rux2ph3mz=0 idiag_ruy2ph1mz=0 idiag_ruy2ph2mz=0 idiag_ruy2ph3mz=0 idiag_ruz2ph1mz=0 idiag_ruz2ph2mz=0 idiag_ruz2ph3mz=0 idiag_ekinph1mz=0 idiag_ekinph2mz=0 idiag_ekinph3mz=0 idiag_uxph1mz=0 idiag_uxph2mz=0 idiag_uxph3mz=0 idiag_uyph1mz=0 idiag_uyph2mz=0 idiag_uyph3mz=0 idiag_uzph1mz=0 idiag_uzph2mz=0 idiag_uzph3mz=0 idiag_u2ph1mz=0 idiag_u2ph2mz=0 idiag_u2ph3mz=0 idiag_ux2ph1mz=0 idiag_ux2ph2mz=0 idiag_ux2ph3mz=0 idiag_uy2ph1mz=0 idiag_uy2ph2mz=0 idiag_uy2ph3mz=0 idiag_uz2ph1mz=0 idiag_uz2ph2mz=0 idiag_uz2ph3mz=0 idiag_oxph1mz=0 idiag_oxph2mz=0 idiag_oxph3mz=0 idiag_oyph1mz=0 idiag_oyph2mz=0 idiag_oyph3mz=0 idiag_ozph1mz=0 idiag_ozph2mz=0 idiag_ozph3mz=0 idiag_ouph1mz=0 idiag_ouph2mz=0 idiag_ouph3mz=0 idiag_sld_char_rms=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),'EEK2',idiag_EEK2) call parse_name(iname,cname(iname),cform(iname),'EEK3',idiag_EEK3) call parse_name(iname,cname(iname),cform(iname),'EEK4',idiag_EEK4) 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),'T00m',idiag_T00m) call parse_name(iname,cname(iname),cform(iname),'Txxm',idiag_Txxm) call parse_name(iname,cname(iname),cform(iname),'Tyym',idiag_Tyym) call parse_name(iname,cname(iname),cform(iname),'Tzzm',idiag_Tzzm) call parse_name(iname,cname(iname),cform(iname),'Txym',idiag_Txym) call parse_name(iname,cname(iname),cform(iname),'Tyzm',idiag_Tyzm) call parse_name(iname,cname(iname),cform(iname),'Tzxm',idiag_Tzxm) call parse_name(iname,cname(iname),cform(iname),'T0x2m',idiag_T0x2m) call parse_name(iname,cname(iname),cform(iname),'T0y2m',idiag_T0y2m) call parse_name(iname,cname(iname),cform(iname),'T0z2m',idiag_T0z2m) 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),'qezxum',idiag_qezxum) call parse_name(iname,cname(iname),cform(iname),'quysm',idiag_quysm) call parse_name(iname,cname(iname),cform(iname),'jxbrqm',idiag_jxbrqm) 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),'uzzrms',idiag_uzzrms) 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) call parse_name(iname,cname(iname),cform(iname),'frict',idiag_frict) call parse_name(iname,cname(iname),cform(iname),'pradrc2',idiag_pradrc2) call parse_name(iname,cname(iname),cform(iname),'sld_char_rms',idiag_sld_char_rms) enddo ! if (idiag_u2tm/=0) then if (iuut==0) call fatal_error("rprint_hydro","Cannot calculate u2tm if iuut==0") endif if (idiag_outm/=0) then if (iuut==0) call fatal_error("rprint_hydro","Cannot calculate outm if iuut==0") endif if (idiag_uotm/=0) then if (ioot==0) call fatal_error("rprint_hydro","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),'uxph1mz',idiag_uxph1mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'uxph2mz',idiag_uxph2mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'uxph3mz',idiag_uxph3mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'uyph1mz',idiag_uyph1mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'uyph2mz',idiag_uyph2mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'uyph3mz',idiag_uyph3mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'uzph1mz',idiag_uzph1mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'uzph2mz',idiag_uzph2mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'uzph3mz',idiag_uzph3mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'u2ph1mz',idiag_u2ph1mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'u2ph2mz',idiag_u2ph2mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'u2ph3mz',idiag_u2ph3mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ux2ph1mz',idiag_ux2ph1mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ux2ph2mz',idiag_ux2ph2mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ux2ph3mz',idiag_ux2ph3mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'uy2ph1mz',idiag_uy2ph1mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'uy2ph2mz',idiag_uy2ph2mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'uy2ph3mz',idiag_uy2ph3mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'uz2ph1mz',idiag_uz2ph1mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'uz2ph2mz',idiag_uz2ph2mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'uz2ph3mz',idiag_uz2ph3mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ouph1mz',idiag_ouph1mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ouph2mz',idiag_ouph2mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ouph3mz',idiag_ouph3mz) 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),'ux3mz',idiag_ux3mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'uy3mz',idiag_uy3mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'uz3mz',idiag_uz3mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ux4mz',idiag_ux4mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'uy4mz',idiag_uy4mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'uz4mz',idiag_uz4mz) 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),'ekinph1mz',idiag_ekinph1mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ekinph2mz',idiag_ekinph2mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ekinph3mz',idiag_ekinph3mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ruxph1mz',idiag_ruxph1mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ruxph2mz',idiag_ruxph2mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ruxph3mz',idiag_ruxph3mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ruyph1mz',idiag_ruyph1mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ruyph2mz',idiag_ruyph2mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ruyph3mz',idiag_ruyph3mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ruzph1mz',idiag_ruzph1mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ruzph2mz',idiag_ruzph2mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ruzph3mz',idiag_ruzph3mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'rux2ph1mz',idiag_rux2ph1mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'rux2ph2mz',idiag_rux2ph2mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'rux2ph3mz',idiag_rux2ph3mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ruy2ph1mz',idiag_ruy2ph1mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ruy2ph2mz',idiag_ruy2ph2mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ruy2ph3mz',idiag_ruy2ph3mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ruz2ph1mz',idiag_ruz2ph1mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ruz2ph2mz',idiag_ruz2ph2mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ruz2ph3mz',idiag_ruz2ph3mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'oxph1mz',idiag_oxph1mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'oxph2mz',idiag_oxph2mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'oxph3mz',idiag_oxph3mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'oyph1mz',idiag_oyph1mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'oyph2mz',idiag_oyph2mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'oyph3mz',idiag_oyph3mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ozph1mz',idiag_ozph1mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ozph2mz',idiag_ozph2mz) call parse_name(inamez,cnamez(inamez),cformz(inamez),'ozph3mz',idiag_ozph3mz) 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) call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'ox2mxz',idiag_ox2mxz) call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'oy2mxz',idiag_oy2mxz) call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'oz2mxz',idiag_oz2mxz) 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),'ox2mxy',idiag_ox2mxy) call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'oy2mxy',idiag_oy2mxy) call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'oz2mxy',idiag_oz2mxy) 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, vecout_finalize 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 ! if (lfargo_advection) then ! ! Call update ghosts as derivatives are needed. ! call update_ghosts(f) ! if (lfargoadvection_as_shift) then call fourier_shift_fargo(f,df,dt_sub) else endif ! ! To disable radial advection, intended for tests in cylindrical coordinates ! if (lno_radial_advection) then f(:,:,:,iux) = 0. df(:,:,:,iux) = 0. endif ! endif 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 not_implemented('hydro_after_timestep','Helmholtz decomposition for non-periodic z') 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 if (ldiagnos.and.othresh_per_orms/=0.) then call vecout_finalize(41,trim(directory)//'/ovec',novec) call calc_othresh 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 ! 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 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, MPI_COMM_WORLD, IXBEAM,IYBEAM ! 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 ! ! 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=IYBEAM) uxmx=sum(fsumxy,dim=2)/nygrid call mpireduce_sum(fnamexy(idiag_uymxy,:,:),fsumxy,(/nx,ny/),idir=IYBEAM) uymx=sum(fsumxy,dim=2)/nygrid call mpireduce_sum(fnamexy(idiag_uzmxy,:,:),fsumxy,(/nx,ny/),idir=IYBEAM) uzmx=sum(fsumxy,dim=2)/nygrid endif if (lfirst_proc_yz) call mpireduce_sum(uxmx**2+uymx**2+uzmx**2,umx2,nx,idir=IXBEAM) 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=IXBEAM) uxmy=sum(fsumxy,dim=1)/nxgrid call mpireduce_sum(fnamexy(idiag_uymxy,:,:),fsumxy,(/nx,ny/),idir=IXBEAM) uymy=sum(fsumxy,dim=1)/nxgrid call mpireduce_sum(fnamexy(idiag_uzmxy,:,:),fsumxy,(/nx,ny/),idir=IXBEAM) uzmy=sum(fsumxy,dim=1)/nxgrid endif if (lfirst_proc_xz) call mpireduce_sum(uxmy**2+uymy**2+uzmy**2,umy2,ny,idir=IYBEAM) 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 . in separate subroutine. ! Should do the same for , , 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 use Sub, only: remove_mean ! 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, 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 ! ! Go through all pencils. ! !!$omp target if(loffload) data !!$omp target if(loffload) data update(reference_state,iref_rho,n1,n2,m1,m2,l1,l2) map(from: rum) has_device_addr(f) !shared: lref, indrhol !!$omp teams distribute parallel do collapse(2) private(rho,mm) reduction(+:rum) 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) + sum(mm) enddo enddo enddo !!$omp end target !!$omp end target data ! ! 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/nwgrid - mean_momentum ! ! Compute inverse density, rho1. ! !!$omp target if(loffload) data map(to: rum) has_device_addr(f) !shared: lref, indrhol !!$omp teams distribute parallel do collapse(2) private(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 !!$omp end target if (lroot.and.ip<6) print*,'remove_mean_momenta: rum=',rum else call remove_mean(f,indux,indux+2) ! as this is equivalent to remove ! mean momenta for constant density endif endsubroutine remove_mean_momenta !*********************************************************************** subroutine remove_mean_angmom(f,induz) ! ! Substract / 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) ! ! To be generalized to also do cyclindrical. ! 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)0.0) then where (f(l1:l2,m,n,iux)> velocity_ceiling) f(l1:l2,m,n,iux)= velocity_ceiling where (f(l1:l2,m,n,iuy)> velocity_ceiling) f(l1:l2,m,n,iuy)= velocity_ceiling where (f(l1:l2,m,n,iuz)> velocity_ceiling) f(l1:l2,m,n,iuz)= velocity_ceiling where (f(l1:l2,m,n,iux)<-velocity_ceiling) f(l1:l2,m,n,iux)=-velocity_ceiling where (f(l1:l2,m,n,iuy)<-velocity_ceiling) f(l1:l2,m,n,iuy)=-velocity_ceiling where (f(l1:l2,m,n,iuz)<-velocity_ceiling) f(l1:l2,m,n,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 ! 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 use General, only: reallocate integer :: nnamerz_prev ! if (nnamerz>0) then nnamerz_prev=nnamerz ! call expand_cname(cnamerz,cformrz,nnamerz,'urmphi','upmphi','uzmphi',name='uumphi') ! if (name_is_present(cnamerz,'upmphi')>0) then ! avoid doubling of upmphi call expand_cname(cnamerz,cformrz,nnamerz,'ursphmphi','uthmphi',name='uusphmphi') else call expand_cname(cnamerz,cformrz,nnamerz,'ursphmphi','uthmphi','upmphi',name='uusphmphi') endif if (nnamerz>nnamerz_prev) then if (.not.reallocate(fnamerz,nnamerz,4)) & call fatal_error('expand_shands_hydro','could not reallocate fnamerz') 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 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. ! lfirstpoint=.true. ! true for very first iteration of m-n loop do imn=1,nyz n=nn(imn) m=mm(imn) 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 lfirstpoint=.false. enddo ! endsubroutine calc_gradu !*********************************************************************** subroutine pushpars2c(p_par) use Syscalls, only: copy_addr use General , only: string_to_enum integer, parameter :: n_pars=110 integer(KIND=ikind8), dimension(n_pars) :: p_par integer :: k call copy_addr(lpressuregradient_gas,p_par(1)) ! int call copy_addr(lupw_uu,p_par(2)) ! int call copy_addr(ladvection_velocity,p_par(3)) ! int call copy_addr(velocity_ceiling,p_par(4)) call copy_addr(r_omega,p_par(5)) call copy_addr(eps_hless,p_par(6)) call copy_addr(itij,p_par(7)) ! int call copy_addr(ihless,p_par(8)) ! int call copy_addr(llinearized_hydro,p_par(9)) ! bool call copy_addr(lprecession,p_par(10)) ! bool call copy_addr(lshear_rateofstrain,p_par(11)) ! bool call copy_addr(luu_sph_as_aux,p_par(12)) ! bool call copy_addr(lvv_as_aux,p_par(13)) ! bool call copy_addr(lvv_as_comaux,p_par(14)) ! bool call copy_addr(lcoriolis_force,p_par(15)) ! bool call copy_addr(lshear_in_coriolis,p_par(16)) ! bool call copy_addr(lcentrifugal_force,p_par(17)) ! bool call copy_addr(lconservative,p_par(18)) ! bool call copy_addr(lrelativistic,p_par(19)) ! bool call copy_addr(full_3d,p_par(20)) ! bool call copy_addr(lhiggsless,p_par(21)) ! bool call copy_addr(lhiggsless_old,p_par(22)) ! bool call copy_addr(ampl_omega,p_par(23)) call copy_addr(loutest,p_par(24)) ! bool call copy_addr(ldiffrot_test,p_par(25)) ! bool call copy_addr(tdamp,p_par(26)) call copy_addr(dampu,p_par(27)) call copy_addr(wdamp,p_par(28)) call copy_addr(dampuint,p_par(29)) call copy_addr(dampuext,p_par(30)) call copy_addr(rdampint,p_par(31)) call copy_addr(rdampext,p_par(32)) call copy_addr(ruxm,p_par(33)) call copy_addr(ruym,p_par(34)) call copy_addr(ruzm,p_par(35)) call copy_addr(tau_damp_ruxm1,p_par(36)) call copy_addr(tau_damp_ruym1,p_par(37)) call copy_addr(tau_damp_ruzm1,p_par(38)) call copy_addr(tau_damp_ruxm,p_par(39)) call copy_addr(tau_damp_ruym,p_par(40)) call copy_addr(tau_damp_ruzm,p_par(41)) call copy_addr(tau_diffrot1,p_par(42)) call copy_addr(omega_int,p_par(43)) call copy_addr(omega_fourier,p_par(44)) call copy_addr(ekman_friction,p_par(45)) call copy_addr(friction_tdep_toffset,p_par(46)) call copy_addr(friction_tdep_tau0,p_par(47)) call copy_addr(t1_ekman,p_par(48)) call copy_addr(t2_ekman,p_par(49)) call copy_addr(uzjet,p_par(50)) call copy_addr(ampl_fcont_uu,p_par(51)) call copy_addr(amp_centforce,p_par(52)) call copy_addr(sbaro0,p_par(53)) call copy_addr(lomega_int,p_par(54)) ! bool call copy_addr(lalways_use_gij_etc,p_par(55)) ! bool call copy_addr(lcalc_uumeanz,p_par(56)) ! bool call copy_addr(lcalc_uumeanxy,p_par(57)) ! bool call copy_addr(lcalc_uumean,p_par(58)) ! bool call copy_addr(lcalc_uumeanx,p_par(59)) ! bool call copy_addr(lcalc_uumeanxz,p_par(60)) ! bool call copy_addr(lforcing_cont_uu,p_par(61)) ! bool call copy_addr(lcoriolis_xdep,p_par(62)) ! bool call copy_addr(lno_meridional_flow,p_par(63)) ! bool call copy_addr(lrotation_xaxis,p_par(64)) ! bool call copy_addr(lgradu_as_aux,p_par(65)) ! bool call copy_addr(lomega_cyl_xy,p_par(66)) ! bool call copy_addr(limpose_only_horizontal_uumz,p_par(67)) ! bool call copy_addr(ltime_integrals_always,p_par(68)) ! bool call copy_addr(lschur_3d3d1d_uu,p_par(69)) ! bool call copy_addr(lschur_2d2d3d_uu,p_par(70)) ! bool call copy_addr(lschur_2d2d1d_uu,p_par(71)) ! bool call copy_addr(dtcor,p_par(72)) call copy_addr(shearx,p_par(73)) call copy_addr(ra,p_par(74)) call copy_addr(pr,p_par(75)) call copy_addr(cdt_tauf,p_par(76)) call copy_addr(lcdt_tauf,p_par(77)) ! bool call copy_addr(idiag_uduum,p_par(78)) ! int call copy_addr(idiag_taufmin,p_par(79)) ! int call copy_addr(idiag_dtf,p_par(80)) ! int call copy_addr(fade_fact,p_par(81)) call copy_addr(uumz,p_par(82)) ! (mz) (3) call copy_addr(uumx,p_par(83)) ! (mx) (3) if (allocated(uumxy)) call copy_addr(uumxy,p_par(84)) ! (mx) (my) (3) call copy_addr(uumxz,p_par(85)) ! (mx) (mz) (3) call copy_addr(uu_average_cyl,p_par(86)) ! (mx) (mz) call copy_addr(uu_average_sph,p_par(87)) ! (mx) (my) call copy_addr(profx_diffrot1,p_par(88)) ! (nx) call copy_addr(profx_diffrot2,p_par(89)) ! (nx) call copy_addr(profx_diffrot3,p_par(90)) ! (nx) call copy_addr(profy_diffrot1,p_par(91)) ! (my) call copy_addr(profy_diffrot2,p_par(92)) ! (my) call copy_addr(profy_diffrot3,p_par(93)) ! (my) call copy_addr(mat_cori,p_par(94)) ! (3) (3) call copy_addr(mat_cent,p_par(95)) ! (3) (3) call copy_addr(uu_const,p_par(96)) ! real3 call copy_addr(prof_om,p_par(97)) ! (nx) call copy_addr(prof_amp1,p_par(98)) ! (nx) call copy_addr(prof_amp3,p_par(99)) ! (mz) call copy_addr(prof_amp4,p_par(100)) ! (my) call copy_addr(uumz_prof,p_par(101)) ! (nz) (3) call copy_addr(omega_prof,p_par(102)) ! (nx) (ny) call copy_addr(Omegav,p_par(103)) ! (3) call string_to_enum(enum_friction_tdep,friction_tdep) call copy_addr(enum_friction_tdep,p_par(104)) ! int call string_to_enum(enum_uuprof,uuprof) call copy_addr(enum_uuprof,p_par(105)) ! int do k = 1,3; call string_to_enum(enum_borderuu(k),borderuu(k)); enddo call copy_addr(enum_borderuu,p_par(106)) ! int3 call copy_addr(w_sldchar_hyd,p_par(107)) call copy_addr(lhubble_hydro,p_par(108)) ! bool endsubroutine pushpars2c !*********************************************************************** endmodule Hydro