! $Id$
!
! This modules deals with all aspects of magnetic fields; if no
! magnetic fields are invoked, a corresponding replacement dummy
! routine is used instead which absorbs all the calls to the
! magnetically relevant subroutines listed in here.
!
!** 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 :: lmagnetic = .true.
! CPARAM logical, parameter :: lbfield = .false.
!
! MVAR CONTRIBUTION 3
! MAUX CONTRIBUTION 0
!
! PENCILS PROVIDED aa(3); a2; aij(3,3); bb(3); bbb(3); ab; ua; exa(3); exatotal(3); aps
! PENCILS PROVIDED b2; b21; bf2; bij(3,3); del2a(3); graddiva(3); jj(3); jj_ohm(3); (3)
! PENCILS PROVIDED curlb(3); e3xa(3)
! PENCILS PROVIDED el(3); e2; bijtilde(3,3),bij_cov_corr(3,3)
! PENCILS PROVIDED j2; jb; va2; jxb(3); jxbr(3); jxbr2; ub; uj; ob; uxb(3); uxbb(3); uxb2
! PENCILS PROVIDED uxj(3); chibp; beta; beta1; uga(3); uuadvec_gaa(3); djuidjbi; jo
! PENCILS PROVIDED StokesI; StokesQ; StokesU; StokesQ1; StokesU1
! PENCILS PROVIDED ujxb; oxuxb(3); jxbxb(3); jxbrxb(3)
! PENCILS PROVIDED gb22(3); ugb(3); ugb22; bgu(3); bgb(3); bgbp(3); ubgbp; bdivu(3)
! PENCILS PROVIDED glnrhoxb(3); del4a(3); del6a(3); oxj(3); diva
! PENCILS PROVIDED jij(3,3); sj; ss12; d6ab
! PENCILS PROVIDED etava; etaj; etaj2; etajrho
! PENCILS PROVIDED cosjb; jparallel; jperp
! PENCILS PROVIDED cosub; bunit(3)
! PENCILS PROVIDED hjj(3); hj2; hjb; coshjb
! PENCILS PROVIDED hjparallel; hjperp; nu_ni1
! PENCILS PROVIDED gamma_A2; clight2; gva(3); vmagfric(3)
! PENCILS PROVIDED bb_sph(3); advec_va2; Lam; gLam(3)
!***************************************************************
module Magnetic
!
use Cdata
use General, only: keep_compiler_quiet, loptest, itoa
!TP: this is ugly but needed to not take pushpars2c from magnetic_meanfield
!If someone knows a more elegant way to filter out a single equation from a module please make this cleaner!
use Magnetic_meanfield, only: register_magn_mf, initialize_magn_mf, init_aa_mf, pencil_criteria_magn_mf, &
pencil_interdep_magn_mf, calc_diagnostics_meanfield,daa_dt_meanfield, &
read_magn_mf_init_pars,write_magn_mf_init_pars, calc_pencils_magn_mf, &
rprint_magn_mf, &
read_magn_mf_run_pars,write_magn_mf_run_pars,pc_aasb_const_alpha,meanfield_after_boundary
use Messages, only: fatal_error,inevitably_fatal_error,warning,svn_id,timing,not_implemented,information
use Special, only: scale_height_init_z !Access the scale height profile from solar_corona.f90
!
implicit none
!
include 'record_types.h'
include 'magnetic.h'
!
interface input_persistent_magnetic
module procedure input_persist_magnetic_id
module procedure input_persist_magnetic
endinterface
!
! Slice precalculation buffers
!
real, target, dimension (:,:,:), allocatable :: bb_xy, jj_xy, poynting_xy ,bb_sph_xy
real, target, dimension (:,:,:), allocatable :: bb_xy2,jj_xy2,poynting_xy2,bb_sph_xy2
real, target, dimension (:,:,:), allocatable :: bb_xy3,jj_xy3,poynting_xy3,bb_sph_xy3
real, target, dimension (:,:,:), allocatable :: bb_xy4,jj_xy4,poynting_xy4,bb_sph_xy4
real, target, dimension (:,:,:), allocatable :: bb_xz, jj_xz, poynting_xz ,bb_sph_xz
real, target, dimension (:,:,:), allocatable :: bb_yz, jj_yz, poynting_yz ,bb_sph_yz
real, target, dimension (:,:,:), allocatable :: bb_xz2,jj_xz2,poynting_xz2,bb_sph_xz2
real, target, dimension (:,:,:,:,:,:), allocatable :: bb_r,jj_r,poynting_r,bb_sph_r
!
real, target, dimension (:,:), allocatable :: b2_xy, jb_xy, j2_xy, ab_xy
real, target, dimension (:,:), allocatable :: b2_xy2,jb_xy2,j2_xy2, ab_xy2
real, target, dimension (:,:), allocatable :: b2_xy3,jb_xy3,j2_xy3, ab_xy3
real, target, dimension (:,:), allocatable :: b2_xy4,jb_xy4,j2_xy4, ab_xy4
real, target, dimension (:,:), allocatable :: b2_yz, jb_yz, j2_yz, ab_yz
real, target, dimension (:,:), allocatable :: b2_xz, jb_xz, j2_xz, ab_xz
real, target, dimension (:,:), allocatable :: b2_xz2,jb_xz2,j2_xz2, ab_xz2
real, target, dimension (:,:,:,:,:), allocatable :: b2_r,jb_r,j2_r,ab_r
!
real, target, dimension (:,:), allocatable :: beta1_xy
real, target, dimension (:,:), allocatable :: beta1_xy2
real, target, dimension (:,:), allocatable :: beta1_xy3
real, target, dimension (:,:), allocatable :: beta1_xy4
real, target, dimension (:,:), allocatable :: beta1_yz
real, target, dimension (:,:), allocatable :: beta1_xz
real, target, dimension (:,:), allocatable :: beta1_xz2
real, target, dimension (:,:,:,:,:), allocatable :: beta1_r
!
real, target, dimension (:,:), allocatable :: aps_xy,aps_xz,aps_yz,aps_xz2
!
! xy-averaged field
!
real, dimension (mz,3) :: aamz
real, dimension (:,:), allocatable :: aamxy, aamxz
!
! Vector potential from file
!
real, dimension (:,:,:,:), allocatable :: ap
!
! Parameters
!
integer, parameter :: nresi_max=4
!
real, dimension (ninit) :: amplaa=0.0, amplaa2=0.0, kx_aa=1.0, ky_aa=1.0, kz_aa=1.0
real, dimension (ninit) :: z0_gaussian=0.0, width_gaussian=0.0
real, dimension (ninit) :: ampl_ax=0.0, ampl_ay=0.0, ampl_az=0.0
real, dimension (ninit) :: kx_ax=0.0, kx_ay=0.0, kx_az=0.0
real, dimension (ninit) :: ky_ax=0.0, ky_ay=0.0, ky_az=0.0
real, dimension (ninit) :: kz_ax=0.0, kz_ay=0.0, kz_az=0.0
real, dimension (ninit) :: phase_ax=0.0, phase_ay=0.0, phase_az=0.0
real, dimension (ninit) :: amplaaJ=0.0, amplaaB=0.0, RFPrad=1.0
real, dimension (ninit) :: phasex_aa=0.0, phasey_aa=0.0, phasez_aa=0.0
real, dimension (ninit) :: phase_aa=0.0
integer, dimension (ninit) :: ll_sh=0, mm_sh=0
integer :: nzav=0,indzav=0,izav_start=1
character (len=fnlen) :: source_zav=''
character (len=labellen), dimension(ninit) :: initaa='nothing', robflow_aa='I'
character (len=labellen), dimension(3) :: borderaa='nothing'
character (len=labellen), dimension(nresi_max) :: iresistivity=''
character (len=labellen) :: ihall_term='const', tdep_eta_type='standard'
!
! Input parameters
!
complex, dimension(3) :: coefaa=(/0.0,0.0,0.0/), coefbb=(/0.0,0.0,0.0/)
real, dimension(3) :: B_ext = 0.0, B0_ext = 0.0, ABCaa=1., widthaa=0.5
real, dimension(3) :: B1_ext, B_ext_inv
real, dimension(3) :: J_ext=(/0.0,0.0,0.0/)
real, dimension(3) :: eta_aniso_hyper3=0.0
real, dimension(2) :: magnetic_xaver_range=(/-max_real,max_real/)
real, dimension(2) :: magnetic_zaver_range=(/-max_real,max_real/)
real, dimension(nx) :: xmask_mag, xmask1_mag
real, dimension(nz) :: zmask_mag
real :: B0_ext_z=0.0, B0_ext_z_H=0.0
real :: sheet_position=1.,sheet_thickness=0.1,sheet_hyp=1.
real :: t_bext = 0.0, t0_bext = 0.0
real :: radius=0.1, epsilonaa=0.01, x0aa=0.0, y0aa=0.0, z0aa=0.0
real :: by_left=0.0, by_right=0.0, bz_left=0.0, bz_right=0.0
real :: relhel_aa=1., nexp_aa=0.
real :: bthresh=0.0, bthresh_per_brms=0.0, bthresh_scl=1.0
real :: eta1_aniso_ratio=impossible, eta1_aniso=impossible
real :: eta1_aniso_r=0.0, eta1_aniso_d=0.0
real :: eta_shock=0.0, eta_shock2=0.0, alp_aniso=0.0, eta_aniso_BB=0.0
real :: quench_aniso=impossible
real :: eta_va=0., eta_j=0., eta_j2=0., eta_jrho=0., eta_min=0., eta_max=0., &
!eta_huge=1e38, etaj20=0., va_min=0., vArms=1.
eta_huge=huge1, etaj20=0., va_min=0., vArms=1.
real :: rhomin_jxb=0.0, va2max_jxb=0.0, va2max_boris=0.0,cmin=0.0
real :: omega_Bz_ext=0.0
real :: mu_r=-0.5 !(still needed for backwards compatibility)
real :: mu_ext_pot=-0.5,inclaa=0.0
real :: mu012=0.5 !(=1/2mu0)
real :: rescale_aa=0.0
real :: ampl_B0=0.0, D_smag=0.17, B_ext2, B_ext21, B_ext11
real :: nu_ni=0.0, nu_ni1, hall_term=0.0, battery_term=0.0
real :: hall_tdep_t0=0.0, hall_tdep_exponent=0.0
real :: Hhall=0., hall_zdep_exponent=4.0
real :: initpower_aa=0.0, initpower2_aa=-11./3., cutoff_aa=0.0, ncutoff_aa=1.
real :: kpeak_aa=10., kgaussian_aa=0., brms_target=1.0, rescaling_fraction=1.0
real :: compk_aa=0.
real :: phase_beltrami=0.0, ampl_beltrami=0.0
real :: bmz=0, bmz_beltrami_phase=0.0
real :: taareset=0.0, daareset=0.0
real :: center1_x=0.0, center1_y=0.0, center1_z=0.0
real :: fluxtube_border_width=impossible
real :: eta_jump=0.0, eta_jump0=0.0, eta_jump1=0.0, eta_jump2=0.0
real :: damp=0., two_step_factor=1.
real :: radRFP=1.
real :: rnoise_int=impossible,rnoise_ext=impossible
real :: znoise_int=impossible,znoise_ext=impossible
real :: mix_factor=0.
real :: RFPradB=1., RFPradJ=1.
real :: th_spot=PI/4
real :: non_ffree_factor=1.
real :: etaB=0.
real :: tau_relprof=0.0, tau_relprof1, amp_relprof=1.0 , k_relprof=1.0
real, pointer :: Hscript, e2m_all, b2m_all, echarge
real :: cp=impossible
real :: dipole_moment=0.0
real :: eta_power_x=0., eta_power_z=0.
real :: z1_aa=0., z2_aa=0.
real :: Pm_smag1=1., k1hel=0., k2hel=max_real, qexp_aa=0.
real :: nfact_aa=4.
real :: r_inner=0., r_outer=0.
real :: eta_tdep_loverride_ee=0.
integer, target :: va2power_jxb = 5
integer :: nbvec, nbvecmax=nx*ny*nz/4, iua=0, iLam=0, idiva=0
integer :: N_modes_aa=1, naareset
logical, pointer :: lrelativistic_eos, lconservative, lrho_chi
logical :: lpress_equil=.false., lpress_equil_via_ss=.false.
logical :: lpress_equil_alt=.false., lset_AxAy_zero=.false.
logical :: llorentzforce=.true., llorentz_rhoref=.false., linduction=.true.
logical :: ldiamagnetism=.false., lcovariant_magnetic=.false.
logical :: ladd_global_field=.false., ladd_bb_init=.false.
logical :: lresi_eta_const=.false.
logical :: lresi_eta_tdep=.false., lresi_eta_xtdep=.false., lresi_eta_ztdep=.false.
logical :: lresi_eta_tdep_t0_norm=.false.
logical :: lresi_sqrtrhoeta_const=.false.
logical :: lresi_eta_aniso=.false., lquench_eta_aniso=.false.
logical :: lresi_etaSS=.false.
logical :: lresi_hyper2=.false.
logical :: lresi_hyper3=.false.
logical :: lresi_hyper2_tdep=.false.
logical :: lresi_hyper3_tdep=.false.
logical :: lresi_hyper3_polar=.false.
logical :: lresi_hyper3_mesh=.false.
logical :: lresi_hyper3_csmesh=.false.
logical :: lresi_hyper3_strict=.false.
logical :: lresi_zdep=.false., lresi_ydep=.false., lresi_xdep=.false., lresi_rdep=.false., lresi_xydep=.false.
logical, dimension(7) :: lresi_dep=.false.
logical :: lresi_dust=.false.
logical :: lresi_hyper3_aniso=.false.
logical :: lresi_eta_shock=.false.
logical :: lresi_eta_shock2=.false.
logical :: lresi_eta_shock_profz=.false.
logical :: lresi_eta_shock_profr=.false.
logical :: lresi_eta_shock_perp=.false.
logical :: lresi_etava=.false.
logical :: lresi_etaj=.false.
logical :: lresi_etaj2=.false.
logical :: lresi_etajrho=.false.
logical :: lresi_shell=.false.
logical :: lresi_smagorinsky=.false.
logical :: lresi_smagorinsky_nusmag=.false.
logical :: lresi_smagorinsky_cross=.false.
logical :: lresi_anomalous=.false.
logical :: lresi_spitzer=.false.
logical :: lresi_cspeed=.false.
logical :: lresi_vAspeed=.false., lalfven_as_aux=.false.
logical :: lresi_magfield=.false.
logical :: lresi_eta_proptouz=.false.
logical, target, dimension (3) :: lfrozen_bb_bot=(/.false.,.false.,.false./)
logical, target, dimension (3) :: lfrozen_bb_top=(/.false.,.false.,.false./)
logical :: lohmic_heat=.true., lneutralion_heat=.true.
logical :: reinitialize_aa=.false., lhubble_magnetic=.false.
logical :: lB_ext_pot=.false., lJ_ext=.false.
logical :: lforce_free_test=.false.
logical :: lforcing_cont_aa_local=.false., lrandom_ampl_aa=.false.
logical :: lee_as_aux=.false., ladd_disp_current_from_aux=.false.
logical :: lbb_as_aux=.false., ljj_as_aux=.false., ljxb_as_aux=.false.
logical :: luxb_as_aux=.false., lugb_as_aux=.false., lbgu_as_aux=.false.
logical :: lbdivu_as_aux=.false.
logical :: lbbt_as_aux=.false., ljjt_as_aux=.false., lua_as_aux=.false.
logical :: lbeta_as_aux=.false.
logical :: letasmag_as_aux=.false.,ljj_as_comaux=.false.
logical :: lbb_as_comaux=.false., lB_ext_in_comaux=.true.
logical :: lbb_sph_as_aux=.false.
logical :: lbext_curvilinear=.true., lcheck_positive_va2=.false.
logical :: lreset_aa=.false., lsmooth_jj=.false., lno_noise_aa=.false.
logical :: lbx_ext_global=.false.,lby_ext_global=.false.,&
lbz_ext_global=.false.
logical :: lax_ext_global=.false.,lay_ext_global=.false.,&
laz_ext_global=.false.
logical :: lambipolar_diffusion=.false.
logical :: lpower_profile_file=.false.
logical :: lskip_projection_aa=.false.
logical :: lscale_tobox=.true., lsquash_aa=.false.
logical :: lbraginsky=.false., l2d_aa=.false.
logical :: lcoulomb=.false., lcoulomb_apply=.false., learly_set_el_pencil=.false.
logical :: lfactors_aa=.false., lvacuum=.false.
logical :: loverride_ee=.false., loverride_ee2=.false., loverride_ee_decide=.false.
logical :: lignore_1rho_in_Lorentz=.false., lnorm_aa_kk=.false., lohm_evolve=.false.
!
namelist /magnetic_init_pars/ &
B_ext, B0_ext, B0_ext_z, B0_ext_z_H, t_bext, t0_bext, J_ext, lohmic_heat, radius, epsilonaa, &
ABCaa, x0aa, y0aa, z0aa, widthaa, nexp_aa, &
RFPradB, RFPradJ, by_left, by_right, bz_left, bz_right, relhel_aa, &
initaa, amplaa, amplaa2, kx_aa, ky_aa, kz_aa, amplaaJ, amplaaB, RFPrad, radRFP, &
robflow_aa, coefaa, coefbb, phase_aa, phasex_aa, phasey_aa, phasez_aa, inclaa, &
lpress_equil, lpress_equil_via_ss, lset_AxAy_zero, ladd_bb_init, &
mu_r, mu_ext_pot, lB_ext_pot, &
alp_aniso, ljj_as_comaux, lsmooth_jj, &
lforce_free_test, ampl_B0, N_modes_aa, lno_noise_aa, &
initpower_aa, initpower2_aa, cutoff_aa, ncutoff_aa, kpeak_aa, &
lscale_tobox, lsquash_aa, kgaussian_aa, lrandom_ampl_aa, z1_aa, z2_aa, &
lcheck_positive_va2, lskip_projection_aa, &
ladd_disp_current_from_aux, compk_aa, &
lbb_as_aux, lbb_as_comaux, lB_ext_in_comaux, lee_as_aux, &
ljxb_as_aux, ljj_as_aux, lbext_curvilinear, lbbt_as_aux, ljjt_as_aux, &
luxb_as_aux, lugb_as_aux, lbgu_as_aux, lbeta_as_aux, lbdivu_as_aux, &
lua_as_aux, lneutralion_heat, center1_x, center1_y, center1_z, &
fluxtube_border_width, va2max_jxb, va2max_boris, cmin,va2power_jxb, eta_jump, &
lpress_equil_alt, rnoise_int, rnoise_ext, mix_factor, damp, &
two_step_factor, th_spot, non_ffree_factor, etaB, ampl_ax, ampl_ay, &
ampl_az, kx_ax, kx_ay, kx_az, ky_ax, ky_ay, ky_az, kz_ax, kz_ay, kz_az, &
phase_ax, phase_ay, phase_az, magnetic_xaver_range, amp_relprof, k_relprof, &
tau_relprof, znoise_int, znoise_ext, magnetic_zaver_range, &
lbx_ext_global,lby_ext_global,lbz_ext_global, dipole_moment, &
lax_ext_global,lay_ext_global,laz_ext_global, &
sheet_position,sheet_thickness,sheet_hyp,ll_sh,mm_sh, &
source_zav,nzav,indzav,izav_start, k1hel, k2hel, lbb_sph_as_aux, &
r_inner, r_outer, lpower_profile_file, eta_jump0, eta_jump1, eta_jump2, &
lcoulomb, lcoulomb_apply, learly_set_el_pencil, &
qexp_aa, nfact_aa, lfactors_aa, lvacuum, l2d_aa, &
loverride_ee_decide, eta_tdep_loverride_ee, z0_gaussian, width_gaussian, &
lnorm_aa_kk, lohm_evolve, lhubble_magnetic
!
! Run parameters
!
real :: eta=0.0, eta1=0.0, eta_hyper2=0.0, eta_hyper3=0.0
real :: eta_tdep_exponent=0.0, eta_tdep_t0=0.0, eta_tdep_toffset=0.0
real :: eta_hyper3_mesh=5.0, eta_spitzer=0., eta_anom=0.0,&
eta_anom_thresh=0.0, eta_ampl=0.
real :: eta_int=0.0, eta_ext=0.0, wresistivity=0.01, eta_xy_max=1.0
real :: height_eta=0.0, eta_out=0.0, eta_cspeed=0.5
real :: tau_aa_exterior=0.0, tauAD=0.0, alev=impossible
real :: sigma_ratio=1.0, eta_z0=1.0, eta_z1=1.0
real :: eta_xwidth=0.0, eta_ywidth=0.0, eta_zwidth=0.0, eta_zwidth2=0.0
real :: eta_rwidth=0.0
real :: eta_width_shock=0.0, eta_zshock=1.0, eta_jump_shock=1.0
real :: eta_xwidth0=0.0, eta_xwidth1=0.0, eta_rwidth0=0.0, eta_rwidth1=0.0
real :: eta_xshock=1.0
real :: eta_x0=1.0, eta_x1=1.0, eta_y0=1.0, eta_y1=1.0
real :: eta_r0=1.0, eta_r1=1.0
real :: alphaSSm=0.0, J_ext_quench=0.0, B2_diamag=0.0
real :: k1_ff=1.0, ampl_ff=1.0, swirl=1.0, k1_ff_mag
real :: k1x_ff=1.0, k1y_ff=1.0, k1z_ff=1.0
real :: inertial_length=0.0, linertial_2
real :: forcing_continuous_aa_phasefact=1.0
real :: forcing_continuous_aa_amplfact=1.0, ampl_fcont_aa=1.0
real :: LLambda_aa=0.0, vcrit_anom=1.0
real :: numag=0.0, B0_magfric=1.0, ekman_friction_aa=0.0
real :: gamma_epspb=2.4, exp_epspb, ncr_quench=0.
real :: ampl_eta_uz=0.0
real :: no_ohmic_heat_z0=1.0, no_ohmic_heat_zwidth=0.0
real :: imp_alpha0=0.0, imp_halpha=0.0, c_light2, c_light21
real, target :: betamin_jxb = 0.0
real, dimension(mx,my) :: eta_xy
real, dimension(mx,my,3) :: geta_xy
real, dimension(nz,3) :: A_relprof
real, dimension(mz) :: coskz,sinkz,eta_z,geta_z
real, dimension(mx) :: eta_x,geta_x
real, dimension(my) :: eta_y,geta_y
real, dimension(nx) :: eta_r
real, dimension(nx,3) :: geta_r
logical :: lfreeze_aint=.false., lfreeze_aext=.false.
logical :: lweyl_gauge=.false., ladvective_gauge=.false.
logical :: lupw_aa=.false., ladvective_gauge2=.false.
logical :: lcalc_aameanz=.false.,lcalc_aamean
equivalence (lcalc_aamean,lcalc_aameanz) ! for compatibility
logical :: lforcing_cont_aa=.false.
integer :: iforcing_cont_aa=0
logical :: lelectron_inertia=.false.
logical :: lkinematic=.false.
logical :: lignore_Bext_in_b2=.false., luse_Bext_in_b2=.true.
logical :: lmean_friction=.false.,llocal_friction=.false.
logical :: lambipolar_strong_coupling=.false.
logical :: lhalox=.false., lno_ohmic_heat_bound_z=.false.
logical :: lrun_initaa=.false.,lmagneto_friction=.false.
logical :: limplicit_resistivity=.false., luse_scale_factor_in_sigma=.true.
logical :: lncr_correlated=.false., lncr_anticorrelated=.false.
logical :: lpropagate_borderaa=.true.
logical :: lremove_meanaz=.false., lremove_meanax=.false., lremove_meanay=.false., &
lremove_meanaxy=.false.,lremove_meanaxz=.false.
logical :: ladd_efield=.false.
logical :: lsld_bb=.false.
logical :: lA_relprof_global=.false.
logical :: lmagnetic_slope_limited=.false.
logical :: lboris_correction=.false.
logical :: lnoinduction=.false.
logical :: lkeplerian_gauge=.false.
logical :: lremove_volume_average=.false.
logical :: lrhs_max=.false.
logical :: ltime_integrals_always=.true.
logical :: lvart_in_shear_frame=.false.
logical :: limp_alpha=.false.
real :: dtcor=0.
real :: h_sld_magn=2.0,nlf_sld_magn=1.0,fac_sld_magn=1.0
real :: ampl_efield=0.
real :: w_sldchar_mag=1., tau_remove_meanaxy=1.0
real :: rhoref=impossible, rhoref1
real :: ell_jj=0., tau_jj=1.
real :: scl_uxb_in_ohm=1.
character (len=labellen) :: A_relaxprofile='0,coskz,0'
character (len=labellen) :: zdep_profile='fs'
character (len=labellen) :: ydep_profile='two-step'
character (len=labellen) :: xdep_profile='two-step'
character (len=labellen) :: rdep_profile='two-step'
character (len=labellen) :: eta_xy_profile='schnack89'
character (len=labellen) :: iforcing_continuous_aa='fixed_swirl'
character (len=labellen) :: ambipolar_diffusion='constant'
character (len=labellen) :: div_sld_magn='2nd'
logical :: lbext_moving_layer=.false., lno_eta_tdep=.false.
real :: zbot_moving_layer=0., ztop_moving_layer=0., speed_moving_layer=0., edge_moving_layer=.1
real :: eta_tdep_ascale_power=0.
!
namelist /magnetic_run_pars/ &
eta, eta1, eta_hyper2, eta_hyper3, eta_anom, eta_anom_thresh, eta_ampl, &
B_ext, B0_ext, B0_ext_z, B0_ext_z_H, t_bext, t0_bext, J_ext, &
J_ext_quench, omega_Bz_ext, nu_ni, hall_term, Hhall, battery_term, &
ihall_term, hall_tdep_t0, hall_tdep_exponent, hall_zdep_exponent, &
eta_hyper3_mesh, eta_tdep_exponent, eta_tdep_t0, &
tdep_eta_type, eta_tdep_toffset, lresi_eta_tdep_t0_norm, &
tau_aa_exterior, tauAD, kx_aa, ky_aa, kz_aa, lcalc_aamean,lohmic_heat, &
lforcing_cont_aa, lforcing_cont_aa_local, iforcing_continuous_aa, &
forcing_continuous_aa_phasefact, forcing_continuous_aa_amplfact, k1_ff, &
ampl_ff, swirl, radius, epsilonaa, k1x_ff, k1y_ff, k1z_ff, &
center1_x, center1_y, center1_z, lcheck_positive_va2, &
lmean_friction, llocal_friction, LLambda_aa, bthresh_per_brms, &
iresistivity, lweyl_gauge, ladvective_gauge, ladvective_gauge2, lupw_aa, &
alphaSSm,eta_int, eta_ext, eta_shock, eta_va,eta_j, eta_j2, eta_jrho, &
eta_min, eta_max, wresistivity, eta_xy_max, rhomin_jxb, va2max_jxb, va2max_boris, &
va_min, cmin,va2power_jxb, llorentzforce, linduction, ldiamagnetism, &
B2_diamag, reinitialize_aa, rescale_aa, initaa, amplaa, lcovariant_magnetic, &
lB_ext_pot, D_smag, brms_target, rescaling_fraction, lfreeze_aint, &
lfreeze_aext, sigma_ratio, zdep_profile, ydep_profile, xdep_profile, &
rdep_profile, height_eta, eta_out, &
eta_xwidth, eta_ywidth, eta_zwidth, eta_rwidth, &
eta_zwidth2, eta_xwidth0, eta_xwidth1, eta_rwidth0, eta_rwidth1, &
eta_z0, eta_z1, eta_y0, eta_y1, eta_x0, eta_x1, eta_r0, eta_r1, &
eta1_aniso_ratio, eta1_aniso, eta1_aniso_r, eta1_aniso_d, alp_aniso, quench_aniso, &
limp_alpha, imp_halpha, imp_alpha0, eta_aniso_BB, &
eta_spitzer, borderaa, ljj_as_comaux, lsmooth_jj, &
eta_aniso_hyper3, lelectron_inertia, inertial_length, &
lbext_curvilinear, lbb_as_aux, lbb_as_comaux, lB_ext_in_comaux, ljj_as_aux, &
luxb_as_aux, lugb_as_aux, lbgu_as_aux, lbdivu_as_aux, &
lkinematic, lbbt_as_aux, ljjt_as_aux, lua_as_aux, ljxb_as_aux, &
lneutralion_heat, lreset_aa, daareset, eta_shock2, &
lignore_Bext_in_b2, luse_Bext_in_b2, ampl_fcont_aa, &
lhalox, vcrit_anom, eta_jump, eta_jump2, lrun_initaa, two_step_factor, &
magnetic_xaver_range, A_relaxprofile, tau_relprof, amp_relprof, &
k_relprof,lmagneto_friction,numag, magnetic_zaver_range,&
lncr_correlated, lncr_anticorrelated, ncr_quench, B0_magfric, ekman_friction_aa, &
lbx_ext_global,lby_ext_global,lbz_ext_global, &
lax_ext_global,lay_ext_global,laz_ext_global, &
limplicit_resistivity,ambipolar_diffusion, betamin_jxb, gamma_epspb, &
lpropagate_borderaa, lremove_meanaz, lremove_meanax, lremove_meanay, lremove_meanaxy, lremove_meanaxz, &
eta_jump_shock, eta_zshock, tau_remove_meanaxy, &
eta_width_shock, eta_xshock, ladd_global_field, eta_power_x, eta_power_z, &
ladd_efield,ampl_efield, h_sld_magn,w_sldchar_mag, lsld_bb, eta_cspeed, &
ladd_disp_current_from_aux, &
lboris_correction,lkeplerian_gauge,lremove_volume_average, &
rhoref, lambipolar_strong_coupling,letasmag_as_aux,Pm_smag1, &
ampl_eta_uz, lalfven_as_aux, lno_ohmic_heat_bound_z, &
no_ohmic_heat_z0, no_ohmic_heat_zwidth, alev, lrhs_max, &
lnoinduction, lA_relprof_global, nlf_sld_magn, fac_sld_magn, div_sld_magn, &
lbb_sph_as_aux, ltime_integrals_always, dtcor, lvart_in_shear_frame, &
lbraginsky, eta_jump0, eta_jump1, lcoulomb, lcoulomb_apply, lvacuum, &
loverride_ee_decide, eta_tdep_loverride_ee, loverride_ee2, lignore_1rho_in_Lorentz, &
lbext_moving_layer, zbot_moving_layer, ztop_moving_layer, speed_moving_layer, edge_moving_layer, &
lno_eta_tdep, luse_scale_factor_in_sigma, ell_jj, tau_jj, lhubble_magnetic, &
scl_uxb_in_ohm, eta_tdep_ascale_power
!
! Diagnostic variables (need to be consistent with reset list below)
!
integer :: idiag_eta_tdep=0 ! DIAG_DOC: $t$-dependent $\eta$
integer :: idiag_ab_int=0 ! DIAG_DOC: $\int\Av\cdot\Bv\;dV$
integer :: idiag_jb_int=0 ! DIAG_DOC: $\int\jv\cdot\Bv\;dV$
integer :: idiag_b2tm=0 ! DIAG_DOC: $\left<\bv(t)\cdot\int_0^t\bv(t')
! DIAG_DOC: dt'\right>$
integer :: idiag_bjtm=0 ! DIAG_DOC: $\left<\bv(t)\cdot\int_0^t\jv(t')
! DIAG_DOC: dt'\right>$
integer :: idiag_jbtm=0 ! DIAG_DOC: $\left<\jv(t)\cdot\int_0^t\bv(t')
! DIAG_DOC: dt'\right>$
integer :: idiag_ujtm=0 ! DIAG_DOC: $\left<\uv(t)\cdot\int_0^t\jv(t')
! DIAG_DOC: dt'\right>$
integer :: idiag_jutm=0 ! DIAG_DOC: $\left<\jv(t)\cdot\int_0^t\uv(t')
! DIAG_DOC: dt'\right>$
integer :: idiag_ubtm=0 ! DIAG_DOC: $\left<\uv(t)\cdot\int_0^t\bv(t')
! DIAG_DOC: dt'\right>$
integer :: idiag_butm=0 ! DIAG_DOC: $\left<\bv(t)\cdot\int_0^t\uv(t')
! DIAG_DOC: dt'\right>$
integer :: idiag_b2ruzm=0 ! DIAG_DOC: $\left<\Bv^2\rho u_z\right>$
integer :: idiag_b2uzm=0 ! DIAG_DOC: $\left<\Bv^2u_z\right>$
integer :: idiag_ubbzm=0 ! DIAG_DOC: $\left<(\uv\cdot\Bv)B_z\right>$
integer :: idiag_b1m=0 ! DIAG_DOC: $\left<|\Bv|\right>$
integer :: idiag_b2m=0 ! DIAG_DOC: $\left<\Bv^2\right>$
integer :: idiag_EEM=0 ! DIAG_DOC: $\left<\Bv^2\right>/2$
integer :: idiag_EEM2=0 ! DIAG_DOC: $\left<(\Bv^2/2)^2\right>$
integer :: idiag_EEM3=0 ! DIAG_DOC: $\left<(\Bv^2/2)^3\right>$
integer :: idiag_EEM4=0 ! DIAG_DOC: $\left<(\Bv^2/2)^4\right>$
integer :: idiag_b4m=0 ! DIAG_DOC: $\left<\Bv^4\right>$
integer :: idiag_b6m=0 ! DIAG_DOC: $\left<\Bv^6\right>$
integer :: idiag_b12m=0 ! DIAG_DOC: $\left<\Bv^12\right>$
integer :: idiag_bm2=0 ! DIAG_DOC: $\max(\Bv^2)$
integer :: idiag_j2m=0 ! DIAG_DOC: $\left<\jv^2\right>$
integer :: idiag_jm2=0 ! DIAG_DOC: $\max(\jv^2)$
integer :: idiag_abm=0 ! DIAG_DOC: $\left<\Av\cdot\Bv\right>$
integer :: idiag_gLamam=0 ! DIAG_DOC: $\left<\nabla\Lambda\cdot\Av\right>$
integer :: idiag_gLambm=0 ! DIAG_DOC: $\left<\nabla\Lambda\cdot\Bv\right>$
integer :: idiag_abumx=0 ! DIAG_DOC: $\left<u_x\Av\cdot\Bv\right>$
integer :: idiag_abumy=0 ! DIAG_DOC: $\left<u_y\Av\cdot\Bv\right>$
integer :: idiag_abumz=0 ! DIAG_DOC: $\left<u_z\Av\cdot\Bv\right>$
integer :: idiag_abmh=0 ! DIAG_DOC: $\left<\Av\cdot\Bv\right>$ (temp)
integer :: idiag_abmn=0 ! DIAG_DOC: $\left<\Av\cdot\Bv\right>$ (north)
integer :: idiag_abms=0 ! DIAG_DOC: $\left<\Av\cdot\Bv\right>$ (south)
integer :: idiag_abrms=0 ! DIAG_DOC: $\left<(\Av\cdot\Bv)^2\right>^{1/2}$
integer :: idiag_jbrms=0 ! DIAG_DOC: $\left<(\jv\cdot\Bv)^2\right>^{1/2}$
integer :: idiag_jxbrms=0 ! DIAG_DOC: $\left<(\jv\times\Bv)^2\right>^{1/2}$
integer :: idiag_ajm=0 ! DIAG_DOC: $\left<\jv\cdot\Av\right>$
integer :: idiag_jbm=0 ! DIAG_DOC: $\left<\jv\cdot\Bv\right>$
integer :: idiag_a2b2m=0 ! DIAG_DOC: $\left<\Av^2\cdot\Bv^2\right>$
integer :: idiag_j2b2m=0 ! DIAG_DOC: $\left<\jv^2\cdot\Bv^2\right>$
integer :: idiag_hjbm=0 ! DIAG_DOC:
integer :: idiag_jbmh=0 ! DIAG_DOC: $\left<\Jv\cdot\Bv\right>$ (temp)
integer :: idiag_jbmn=0 ! DIAG_DOC: $\left<\Jv\cdot\Bv\right>$ (north)
integer :: idiag_jbms=0 ! DIAG_DOC: $\left<\Jv\cdot\Bv\right>$ (south)
integer :: idiag_ubm=0 ! DIAG_DOC: $\left<\uv\cdot\Bv\right>$
integer :: idiag_dubrms=0 ! DIAG_DOC: $\left<(\uv-\Bv)^2\right>^{1/2}$
integer :: idiag_dobrms=0 ! DIAG_DOC: $\left<(\boldsymbol{\omega}-\Bv)^2
! DIAG_DOC: \right>^{1/2}$
integer :: idiag_uxbxm=0 ! DIAG_DOC: $\left<u_xB_x\right>$
integer :: idiag_uybxm=0 ! DIAG_DOC: $\left<u_yB_x\right>$
integer :: idiag_uzbxm=0 ! DIAG_DOC: $\left<u_zB_x\right>$
integer :: idiag_uxbym=0 ! DIAG_DOC: $\left<u_xB_y\right>$
integer :: idiag_uybym=0 ! DIAG_DOC: $\left<u_yB_y\right>$
integer :: idiag_uzbym=0 ! DIAG_DOC: $\left<u_zB_y\right>$
integer :: idiag_uxbzm=0 ! DIAG_DOC: $\left<u_xB_z\right>$
integer :: idiag_uybzm=0 ! DIAG_DOC: $\left<u_yB_z\right>$
integer :: idiag_uzbzm=0 ! DIAG_DOC: $\left<u_zB_z\right>$
integer :: idiag_uxjxm=0 ! DIAG_DOC: $\left<u_xJ_x\right>$
integer :: idiag_uxjym=0 ! DIAG_DOC: $\left<u_xJ_y\right>$
integer :: idiag_uxjzm=0 ! DIAG_DOC: $\left<u_xJ_z\right>$
integer :: idiag_uyjxm=0 ! DIAG_DOC: $\left<u_yJ_x\right>$
integer :: idiag_uyjym=0 ! DIAG_DOC: $\left<u_yJ_y\right>$
integer :: idiag_uyjzm=0 ! DIAG_DOC: $\left<u_yJ_z\right>$
integer :: idiag_uzjxm=0 ! DIAG_DOC: $\left<u_zJ_x\right>$
integer :: idiag_uzjym=0 ! DIAG_DOC: $\left<u_zJ_y\right>$
integer :: idiag_uzjzm=0 ! DIAG_DOC: $\left<u_zJ_z\right>$
integer :: idiag_cosubm=0 ! DIAG_DOC: $\left<\Uv\cdot\Bv/(|\Uv|\,|\Bv|)
! DIAG_DOC: \right>$
integer :: idiag_jxbxm=0 ! DIAG_DOC: $\left<j_xB_x\right>$
integer :: idiag_jybxm=0 ! DIAG_DOC: $\left<j_yB_x\right>$
integer :: idiag_jzbxm=0 ! DIAG_DOC: $\left<j_zB_x\right>$
integer :: idiag_jxbym=0 ! DIAG_DOC: $\left<j_xB_y\right>$
integer :: idiag_jybym=0 ! DIAG_DOC: $\left<j_yB_y\right>$
integer :: idiag_jzbym=0 ! DIAG_DOC: $\left<j_zB_y\right>$
integer :: idiag_jxbzm=0 ! DIAG_DOC: $\left<j_xB_z\right>$
integer :: idiag_jybzm=0 ! DIAG_DOC: $\left<j_yB_z\right>$
integer :: idiag_jzbzm=0 ! DIAG_DOC: $\left<j_zB_z\right>$
integer :: idiag_uam=0 ! DIAG_DOC: $\left<\uv\cdot\Av\right>$
integer :: idiag_obm=0 ! DIAG_DOC: $\left<\ov\cdot\Bv\right>$
integer :: idiag_ujm=0 ! DIAG_DOC: $\left<\uv\cdot\Jv\right>$
integer :: idiag_fbm=0 ! DIAG_DOC: $\left<\fv\cdot\Bv\right>$
integer :: idiag_fxbxm=0 ! DIAG_DOC: $\left<f_x B_x\right>$
integer :: idiag_epsM=0 ! DIAG_DOC: $\left<\eta\mu_0\jv^2\right>$
integer :: idiag_epsM2=0 ! DIAG_DOC: $\left<(\eta\mu_0\jv^2)^2\right>$
integer :: idiag_epsM3=0 ! DIAG_DOC: $\left<(\eta\mu_0\jv^2)^3\right>$
integer :: idiag_epsM4=0 ! DIAG_DOC: $\left<(\eta\mu_0\jv^2)^4\right>$
integer :: idiag_epsAD=0 ! DIAG_DOC: $\left<\rho^{-1} t_{\rm AD}
! DIAG_DOC: (\vec{J}\times\vec{B})^2\right>$
! DIAG_DOC: (heating by ion-neutrals friction)
integer :: idiag_bxpt=0 ! DIAG_DOC: $B_x(x_1,y_1,z_1,t)$
integer :: idiag_bypt=0 ! DIAG_DOC: $B_y(x_1,y_1,z_1,t)$
integer :: idiag_bzpt=0 ! DIAG_DOC: $B_z(x_1,y_1,z_1,t)$
integer :: idiag_bxbypt=0 ! DIAG_DOC: $(B_x B_y)(x_1,y_1,z_1,t)$
integer :: idiag_bybzpt=0 ! DIAG_DOC: $(B_y B_z)(x_1,y_1,z_1,t)$
integer :: idiag_bzbxpt=0 ! DIAG_DOC: $(B_z B_x)(x_1,y_1,z_1,t)$
integer :: idiag_jxpt=0 ! DIAG_DOC: $J_x(x_1,y_1,z_1,t)$
integer :: idiag_jypt=0 ! DIAG_DOC: $J_y(x_1,y_1,z_1,t)$
integer :: idiag_jzpt=0 ! DIAG_DOC: $J_z(x_1,y_1,z_1,t)$
integer :: idiag_Expt=0 ! DIAG_DOC: ${\cal E}_x(x_1,y_1,z_1,t)$
integer :: idiag_Eypt=0 ! DIAG_DOC: ${\cal E}_y(x_1,y_1,z_1,t)$
integer :: idiag_Ezpt=0 ! DIAG_DOC: ${\cal E}_z(x_1,y_1,z_1,t)$
integer :: idiag_axpt=0 ! DIAG_DOC: $A_x(x_1,y_1,z_1,t)$
integer :: idiag_aypt=0 ! DIAG_DOC: $A_y(x_1,y_1,z_1,t)$
integer :: idiag_azpt=0 ! DIAG_DOC: $A_z(x_1,y_1,z_1,t)$
integer :: idiag_bxp2=0 ! DIAG_DOC: $B_x(x_2,y_2,z_2,t)$
integer :: idiag_byp2=0 ! DIAG_DOC: $B_y(x_2,y_2,z_2,t)$
integer :: idiag_bzp2=0 ! DIAG_DOC: $B_z(x_2,y_2,z_2,t)$
integer :: idiag_jxp2=0 ! DIAG_DOC: $J_x(x_2,y_2,z_2,t)$
integer :: idiag_jyp2=0 ! DIAG_DOC: $J_y(x_2,y_2,z_2,t)$
integer :: idiag_jzp2=0 ! DIAG_DOC: $J_z(x_2,y_2,z_2,t)$
integer :: idiag_Exp2=0 ! DIAG_DOC: ${\cal E}_x(x_2,y_2,z_2,t)$
integer :: idiag_Eyp2=0 ! DIAG_DOC: ${\cal E}_y(x_2,y_2,z_2,t)$
integer :: idiag_Ezp2=0 ! DIAG_DOC: ${\cal E}_z(x_2,y_2,z_2,t)$
integer :: idiag_axp2=0 ! DIAG_DOC: $A_x(x_2,y_2,z_2,t)$
integer :: idiag_ayp2=0 ! DIAG_DOC: $A_y(x_2,y_2,z_2,t)$
integer :: idiag_azp2=0 ! DIAG_DOC: $A_z(x_2,y_2,z_2,t)$
integer :: idiag_epsM_LES=0 ! DIAG_DOC:
integer :: idiag_aybym2=0 ! DIAG_DOC:
integer :: idiag_exaym2=0 ! DIAG_DOC:
integer :: idiag_exabot=0 ! DIAG_DOC: $\int\Ev\times\Av\,dS|_{\rm bot}$
integer :: idiag_exatop=0 ! DIAG_DOC: $\int\Ev\times\Av\,dS|_{\rm top}$
integer :: idiag_exjm2=0 ! DIAG_DOC:
! hongzhe: note emag is the integrated energy, whereas ekin is the volume average!
! the hydro counterpart of emag is ekintot
integer :: idiag_emag=0 ! DIAG_DOC: $\int_V{1\over2\mu_0}\Bv^2\, dV$
integer :: idiag_km0EM=0 ! DIAG_DOC: $\int E_M(k)\,dk$
integer :: idiag_km1EM=0 ! DIAG_DOC: $\int k^{-1} E_M(k)\,dk$
integer :: idiag_brms=0 ! DIAG_DOC: $\left<\Bv^2\right>^{1/2}$
integer :: idiag_bfrms=0 ! DIAG_DOC: $\left<{\Bv'}^2\right>^{1/2}$
integer :: idiag_bf2m=0 ! DIAG_DOC: $\left<{\Bv'}^2\right>$
integer :: idiag_bf4m=0 ! DIAG_DOC: $\left<{\Bv'}^4\right>$
integer :: idiag_bmax=0 ! DIAG_DOC: $\max(|\Bv|)$
integer :: idiag_bxmin=0 ! DIAG_DOC: $\min(|B_x|)$
integer :: idiag_bymin=0 ! DIAG_DOC: $\min(|B_y|)$
integer :: idiag_bzmin=0 ! DIAG_DOC: $\min(|B_z|)$
integer :: idiag_bxmax=0 ! DIAG_DOC: $\max(|B_x|)$
integer :: idiag_bymax=0 ! DIAG_DOC: $\max(|B_y|)$
integer :: idiag_bzmax=0 ! DIAG_DOC: $\max(|B_z|)$
integer :: idiag_bbxmax=0 ! DIAG_DOC: $\max(|B_x|) excluding Bv_{ext}$
integer :: idiag_bbymax=0 ! DIAG_DOC: $\max(|B_y|) excluding Bv_{ext}$
integer :: idiag_bbzmax=0 ! DIAG_DOC: $\max(|B_z|) excluding Bv_{ext}$
integer :: idiag_jxmax=0 ! DIAG_DOC: $\max(|jv_x|)$
integer :: idiag_jymax=0 ! DIAG_DOC: $\max(|jv_y|)$
integer :: idiag_jzmax=0 ! DIAG_DOC: $\max(|jv_z|)$
integer :: idiag_jrms=0 ! DIAG_DOC: $\left<\jv^2\right>^{1/2}$
integer :: idiag_hjrms=0 ! DIAG_DOC: $\left<\jv^2\right>^{1/2}$
integer :: idiag_jmax=0 ! DIAG_DOC: $\max(|\jv|)$
integer :: idiag_vA23rms=0 ! DIAG_DOC: $\left<\Bv^2/\varrho^{4/3}\right>^{1/2}$
integer :: idiag_vArms=0 ! DIAG_DOC: $\left<\Bv^2/\varrho\right>^{1/2}$
integer :: idiag_vAmax=0 ! DIAG_DOC: $\max(\Bv^2/\varrho)^{1/2}$
integer :: idiag_dtb=0 ! DIAG_DOC: $\delta t / [c_{\delta t}\,\delta x
! DIAG_DOC: /v_{\rm A,max}]$
! DIAG_DOC: \quad(time step relative to
! DIAG_DOC: Alfv{\'e}n time step;
! DIAG_DOC: see \S~\ref{time-step})
integer :: idiag_dteta=0 ! DIAG_DOC: $\delta t/[c_{\delta t,{\rm v}}\,
! DIAG_DOC: \delta x^2/\eta_{\rm max}]$
! DIAG_DOC: \quad(time step relative to
! DIAG_DOC: resistive time step;
! DIAG_DOC: see \S~\ref{time-step})
integer :: idiag_dteta3=0 ! DIAG_DOC: $\delta t/[c_{\delta t,{\rm v3}}\,
! DIAG_DOC: \delta x^6/\eta^{\rm hyper}_{\rm max}]$
! DIAG_DOC: \quad(time step relative to
! DIAG_DOC: hyper resistive time step;
! DIAG_DOC: see \S~\ref{time-step})
integer :: idiag_dtHr=0 ! DIAG_DOC:
integer :: idiag_dtFr=0 ! DIAG_DOC:
integer :: idiag_dtBr=0 ! DIAG_DOC:
integer :: idiag_axm=0 ! DIAG_DOC:
integer :: idiag_aym=0 ! DIAG_DOC:
integer :: idiag_azm=0 ! DIAG_DOC:
integer :: idiag_a2m=0 ! DIAG_DOC: $\left<\Av^2\right>$
integer :: idiag_arms=0 ! DIAG_DOC: $\left<\Av^2\right>^{1/2}$
integer :: idiag_amax=0 ! DIAG_DOC: $\max(|\Av|)$
integer :: idiag_divarms=0 ! DIAG_DOC: $\langle(\nabla\cdot\Av)^2\rangle^{1/2}$
integer :: idiag_beta1m=0 ! DIAG_DOC: $\left<\Bv^2/(2\mu_0 p)\right>$
! DIAG_DOC: \quad(mean inverse plasma beta)
integer :: idiag_beta1max=0 ! DIAG_DOC: $\max[\Bv^2/(2\mu_0 p)]$
! DIAG_DOC: \quad(maximum inverse plasma beta)
integer :: idiag_betam = 0 ! DIAG_DOC: $\langle\beta\rangle$
integer :: idiag_betamax = 0 ! DIAG_DOC: $\max\beta$
integer :: idiag_betamin = 0 ! DIAG_DOC: $\min\beta$
integer :: idiag_Azmid_min=0 ! DIAG_DOC: $\min A_z^{\rm mid}$
integer :: idiag_Azmid_max=0 ! DIAG_DOC: $\max A_z^{\rm mid}$
integer :: idiag_bxm=0 ! DIAG_DOC: $\left<B_x\right>$
integer :: idiag_bym=0 ! DIAG_DOC: $\left<B_y\right>$
integer :: idiag_bzm=0 ! DIAG_DOC: $\left<B_z\right>$
integer :: idiag_jxm=0 ! DIAG_DOC: $\left<J_x\right>$
integer :: idiag_jym=0 ! DIAG_DOC: $\left<J_y\right>$
integer :: idiag_jzm=0 ! DIAG_DOC: $\left<J_z\right>$
integer :: idiag_bxbym=0 ! DIAG_DOC: $\left<B_x B_y\right>$
integer :: idiag_bxbzm=0 ! DIAG_DOC: $\left<B_x B_z\right>$
integer :: idiag_bybzm=0 ! DIAG_DOC: $\left<B_y B_z\right>$
integer :: idiag_djuidjbim=0 ! DIAG_DOC:
integer :: idiag_bij_cov_diffmax=0! DIAG_DOC: difference between two implementations of covariant derivatives
integer :: idiag_bmx=0 ! DIAG_DOC: $\left<\left<\Bv\right>_{yz}^2
! DIAG_DOC: \right>^{1/2}$
! DIAG_DOC: \quad(energy of $yz$-averaged
! DIAG_DOC: mean field)
integer :: idiag_bmy=0 ! DIAG_DOC: $\left<\left<\Bv\right>_{xz}^2
! DIAG_DOC: \right>^{1/2}$
! DIAG_DOC: \quad(energy of $xz$-averaged
! DIAG_DOC: mean field)
integer :: idiag_bmz=0 ! DIAG_DOC: $\left<\left<\Bv\right>_{xy}^2
! DIAG_DOC: \right>^{1/2}$
! DIAG_DOC: \quad(energy of $xy$-averaged
! DIAG_DOC: mean field)
integer :: idiag_bmzS2=0 ! DIAG_DOC: $\left<\left<\Bv_S\right>_{xy}^2\right>$
integer :: idiag_bmzA2=0 ! DIAG_DOC: $\left<\left<\Bv_A\right>_{xy}^2\right>$
integer :: idiag_jmx=0 ! DIAG_DOC: $\left<\left<\Jv\right>_{yz}^2
! DIAG_DOC: \right>^{1/2}$
! DIAG_DOC: \quad(energy of $yz$-averaged
! DIAG_DOC: mean current density)
integer :: idiag_jmy=0 ! DIAG_DOC: $\left<\left<\Jv\right>_{xz}^2
! DIAG_DOC: \right>^{1/2}$
! DIAG_DOC: \quad(energy of $xz$-averaged
! DIAG_DOC: mean current density)
integer :: idiag_jmz=0 ! DIAG_DOC: $\left<\left<\Jv\right>_{xy}^2
! DIAG_DOC: \right>^{1/2}$
! DIAG_DOC: \quad(energy of $xy$-averaged
! DIAG_DOC: mean current density)
integer :: idiag_bmzph=0 ! DIAG_DOC: Phase of a Beltrami field
integer :: idiag_bmzphe=0 ! DIAG_DOC: Error of phase of a Beltrami field
integer :: idiag_bsinphz=0 ! DIAG_DOC: sine of phase of a Beltrami field
integer :: idiag_bcosphz=0 ! DIAG_DOC: cosine of phase of a Beltrami field
integer :: idiag_emxamz3=0 ! DIAG_DOC: $\left<\left<\Ev\right>_{xy}\times\left<\Av\right>_{xy}
! DIAG_DOC: \right>$ \quad($xy$-averaged
! DIAG_DOC: mean field helicity flux)
integer :: idiag_embmz=0 ! DIAG_DOC: $\left<\left<\Ev\right>_{xy}\cdot\left<\Bv\right>_{xy}
! DIAG_DOC: \right>$ \quad($xy$-averaged
! DIAG_DOC: mean field helicity production )
integer :: idiag_ambmz=0 ! DIAG_DOC: $\left<\left<\Av\right>_{xy}\cdot\left<\Bv\right>_{xy}\right>$
! DIAG_DOC: \quad (magnetic helicity of $xy$-averaged mean field)
integer :: idiag_ambmzh=0 ! DIAG_DOC: $\left<\left<\Av\right>_{xy}\cdot\left<\Bv\right>_{xy}\right>$
! DIAG_DOC: \quad (magnetic helicity of $xy$-averaged mean field, temp)
integer :: idiag_ambmzn=0 ! DIAG_DOC: $\left<\left<\Av\right>_{xy}\cdot\left<\Bv\right>_{xy}\right>$
! DIAG_DOC: \quad (magnetic helicity of $xy$-averaged mean field, north)
integer :: idiag_ambmzs=0 ! DIAG_DOC: $\left<\left<\Av\right>_{xy}\cdot\left<\Bv\right>_{xy}\right>$
! DIAG_DOC: \quad (magnetic helicity of $xy$-averaged mean field, south)
integer :: idiag_jmbmz=0 ! DIAG_DOC: $\left<\left<\Jv\right>_{xy}\cdot\left<\Bv\right>_{xy}
! DIAG_DOC: \right>$ \quad(current helicity
! DIAG_DOC: of $xy$-averaged mean field)
integer :: idiag_Rmmz=0 ! DIAG_DOC: $\left<\frac{|\uv\times\Bv|}{|\eta\Jv|}
! DIAG_DOC: \right>_{xy}$
integer :: idiag_kx_aa=0 ! DIAG_DOC: $k_x$
integer :: idiag_kmz=0 ! DIAG_DOC: $\left<\left<\Jv\right>_{xy}\cdot\left<\Bv\right>_{xy}\right>/
! DIAG_DOC: \left<\left<\Bv\right>_{xy}^2\right>$
integer :: idiag_bx2m=0 ! DIAG_DOC: $\left< B_x^2 \right>$
integer :: idiag_by2m=0 ! DIAG_DOC: $\left< B_y^2 \right>$
integer :: idiag_bz2m=0 ! DIAG_DOC: $\left< B_z^2 \right>$
integer :: idiag_bx3m=0 ! DIAG_DOC: $\left< B_x^3 \right>$
integer :: idiag_by3m=0 ! DIAG_DOC: $\left< B_y^3 \right>$
integer :: idiag_bz3m=0 ! DIAG_DOC: $\left< B_z^3 \right>$
integer :: idiag_bx4m=0 ! DIAG_DOC: $\left< B_x^4 \right>$
integer :: idiag_by4m=0 ! DIAG_DOC: $\left< B_y^4 \right>$
integer :: idiag_bz4m=0 ! DIAG_DOC: $\left< B_z^4 \right>$
integer :: idiag_jx2m=0 ! DIAG_DOC: $\left< J_x^2 \right>$
integer :: idiag_jy2m=0 ! DIAG_DOC: $\left< J_y^2 \right>$
integer :: idiag_jz2m=0 ! DIAG_DOC: $\left< J_z^2 \right>$
integer :: idiag_jx4m=0 ! DIAG_DOC: $\left< J_x^4 \right>$
integer :: idiag_jy4m=0 ! DIAG_DOC: $\left< J_y^4 \right>$
integer :: idiag_jz4m=0 ! DIAG_DOC: $\left< J_z^4 \right>$
integer :: idiag_jh2m1=0 ! DIAG_DOC: $\left< J_\perp^2 \right>^{I}$
integer :: idiag_jx2m1=0 ! DIAG_DOC: $\left< J_x^2 \right>^{I}$
integer :: idiag_jy2m1=0 ! DIAG_DOC: $\left< J_y^2 \right>^{I}$
integer :: idiag_jx2m2=0 ! DIAG_DOC: $\left< J_x^2 \right>^{II}$
integer :: idiag_jy2m2=0 ! DIAG_DOC: $\left< J_y^2 \right>^{II}$
integer :: idiag_jx2m3=0 ! DIAG_DOC: $\left< J_x^2 \right>^{III}$
integer :: idiag_jy2m3=0 ! DIAG_DOC: $\left< J_y^2 \right>^{III}$
integer :: idiag_uxbm=0 ! DIAG_DOC: $\left<\uv\times\Bv\right>\cdot\Bv_0/B_0^2$
integer :: idiag_jxbm=0 ! DIAG_DOC: $\left<\jv\times\Bv\right>\cdot\Bv_0/B_0^2$
integer :: idiag_vmagfricmax=0 ! DIAG_DOC: $\max(1/\nu_{\rm mag}|\jv\times\Bv/\Bv^2|)$
integer :: idiag_vmagfricrms=0 ! DIAG_DOC: $\left<1/\nu_{\rm mag}|\jv\times\Bv/\Bv^2|^2\right>^{1/2}$
integer :: idiag_oxuxbm=0 ! DIAG_DOC:
integer :: idiag_jxbxbm=0 ! DIAG_DOC:
integer :: idiag_gpxbm=0 ! DIAG_DOC:
integer :: idiag_uxDxuxbm=0 ! DIAG_DOC:
integer :: idiag_b3b21m=0 ! DIAG_DOC: $\left<B_3 B_{2,1} \right>$
integer :: idiag_b3b12m=0 ! DIAG_DOC: $\left<B_3 B_{1,2} \right>$
integer :: idiag_b1b32m=0 ! DIAG_DOC: $\left<B_1 B_{3,2} \right>$
integer :: idiag_b1b23m=0 ! DIAG_DOC: $\left<B_1 B_{2,3} \right>$
integer :: idiag_b2b13m=0 ! DIAG_DOC: $\left<B_2 B_{1,3} \right>$
integer :: idiag_b2b31m=0 ! DIAG_DOC: $\left<B_2 B_{3,1} \right>$
integer :: idiag_udotxbm=0 ! DIAG_DOC:
integer :: idiag_uxbdotm=0 ! DIAG_DOC:
integer :: idiag_uxbmx=0 ! DIAG_DOC: $\left<(\uv\times\Bv)_x\right>$
integer :: idiag_uxbmy=0 ! DIAG_DOC: $\left<(\uv\times\Bv)_y\right>$
integer :: idiag_uxbmz=0 ! DIAG_DOC: $\left<(\uv\times\Bv)_z\right>$
integer :: idiag_jxbmx=0 ! DIAG_DOC: $\left<(\jv\times\Bv)_x\right>$
integer :: idiag_jxbmy=0 ! DIAG_DOC: $\left<(\jv\times\Bv)_y\right>$
integer :: idiag_jxbmz=0 ! DIAG_DOC: $\left<(\jv\times\Bv)_z\right>$
integer :: idiag_uxbcmx=0 ! DIAG_DOC:
integer :: idiag_uxbcmy=0 ! DIAG_DOC:
integer :: idiag_uxbsmx=0 ! DIAG_DOC:
integer :: idiag_uxbsmy=0 ! DIAG_DOC:
integer :: idiag_examx=0 ! DIAG_DOC: $\left<\Ev\times\Av\right>|_x$
integer :: idiag_examy=0 ! DIAG_DOC: $\left<\Ev\times\Av\right>|_y$
integer :: idiag_examz=0 ! DIAG_DOC: $\left<\Ev\times\Av\right>|_z$
integer :: idiag_exatotalmx=0 ! DIAG_DOC: $\left<\Ev\times\Av\right>|_x$
integer :: idiag_exatotalmy=0 ! DIAG_DOC: $\left<\Ev\times\Av\right>|_y$
integer :: idiag_exatotalmz=0 ! DIAG_DOC: $\left<\Ev\times\Av\right>|_z$
integer :: idiag_exjmx=0 ! DIAG_DOC: $\left<\Ev\times\Jv\right>|_x$
integer :: idiag_exjmy=0 ! DIAG_DOC: $\left<\Ev\times\Jv\right>|_y$
integer :: idiag_exjmz=0 ! DIAG_DOC: $\left<\Ev\times\Jv\right>|_z$
integer :: idiag_dexbmx=0 ! DIAG_DOC: $\left<\nabla\times\Ev\times\Bv\right>|_x$
integer :: idiag_dexbmy=0 ! DIAG_DOC: $\left<\nabla\times\Ev\times\Bv\right>|_y$
integer :: idiag_dexbmz=0 ! DIAG_DOC: $\left<\nabla\times\Ev\times\Bv\right>|_z$
integer :: idiag_phibmx=0 ! DIAG_DOC: $\left<\phi\Bv\right>|_x$
integer :: idiag_phibmy=0 ! DIAG_DOC: $\left<\phi\Bv\right>|_y$
integer :: idiag_phibmz=0 ! DIAG_DOC: $\left<\phi\Bv\right>|_z$
integer :: idiag_uxjm=0 ! DIAG_DOC:
integer :: idiag_b2divum=0 ! DIAG_DOC: $\left<\Bv^2\nabla\cdot\uv\right>$
integer :: idiag_jdel2am=0 ! DIAG_DOC: $\left<\Jv\cdot\nabla^2\Av)\right>$
integer :: idiag_jem=0 ! DIAG_DOC: $\left<\jv\cdot\Ev\right>$
integer :: idiag_aem=0 ! DIAG_DOC: $\left<\Av\cdot\Ev\right>$
integer :: idiag_ujxbm=0 ! DIAG_DOC: $\left<\uv\cdot(\Jv\times\Bv)\right>$
integer :: idiag_WL2D=0 ! DIAG_DOC: $\left<J_i u_j A_{i,j} \right>$
integer :: idiag_WL3D=0 ! DIAG_DOC: $-\left<J_i u_j A_{j,i} \right>$
integer :: idiag_WL3D2=0 ! DIAG_DOC: $\left<J_i A_j u_{j,i} \right>$
integer :: idiag_bij2m=0 ! DIAG_DOC: $\left<|\hat{B}_{i,j}|^2\right>$
integer :: idiag_sijbibjm=0 ! DIAG_DOC: $\left<S_{i,j} B_i B_j\right>$
integer :: idiag_ubgbpm=0 ! DIAG_DOC: $\left<\uv\cdot(\Bv\cdot\nabla\Bv)\right>$
integer :: idiag_ugb22m=0 ! DIAG_DOC: $\left<\uv\cdot\nabla\Bv^2/2)\right>$
integer :: idiag_jxbrxm=0 ! DIAG_DOC:
integer :: idiag_jxbrym=0 ! DIAG_DOC:
integer :: idiag_jxbrzm=0 ! DIAG_DOC:
integer :: idiag_jxbrmax=0 ! DIAG_DOC: $\max(|\Jv\times\Bv/\rho|)$
integer :: idiag_jxbr2m=0 ! DIAG_DOC: $\left<(\Jv\times\Bv/\rho)^2\right>$
integer :: idiag_jxbrqm=0 ! DIAG_DOC: $\left<(\Jv\times\Bv/\rho)\cdot\mathbf{q}\right>$
integer :: idiag_uxBrms=0 ! DIAG_DOC:
integer :: idiag_Bresrms=0 ! DIAG_DOC:
integer :: idiag_Rmrms=0 ! DIAG_DOC:
integer :: idiag_jfm=0 ! DIAG_DOC:
integer :: idiag_brbpmr=0 ! DIAG_DOC:
integer :: idiag_vA2m=0 ! DIAG_DOC:
integer :: idiag_b2mr=0 ! DIAG_DOC:
integer :: idiag_brmr=0 ! DIAG_DOC:
integer :: idiag_bpmr=0 ! DIAG_DOC:
integer :: idiag_bzmr=0 ! DIAG_DOC:
integer :: idiag_armr=0 ! DIAG_DOC:
integer :: idiag_apmr=0 ! DIAG_DOC:
integer :: idiag_azmr=0 ! DIAG_DOC:
integer :: idiag_mflux_x=0 ! DIAG_DOC:
integer :: idiag_mflux_y=0 ! DIAG_DOC:
integer :: idiag_mflux_z=0 ! DIAG_DOC:
integer :: idiag_bmxy_rms=0 ! DIAG_DOC: $\sqrt{[\left<b_x\right>_z(x,y)]^2 +
! DIAG_DOC: [\left<b_y\right>_z(x,y)]^2 +
! DIAG_DOC: [\left<b_z\right>_z(x,y)]^2} $
integer :: idiag_etasmagm=0 ! DIAG_DOC: Mean of Smagorinsky resistivity
integer :: idiag_etasmagmin=0 ! DIAG_DOC: Min of Smagorinsky resistivity
integer :: idiag_etasmagmax=0 ! DIAG_DOC: Max of Smagorinsky resistivity
integer :: idiag_etavamax=0 ! DIAG_DOC: Max of artificial resistivity
! DIAG_DOC: $\eta\sim v_A$
integer :: idiag_etajmax=0 ! DIAG_DOC: Max of artificial resistivity
! DIAG_DOC: $\eta\sim J / \sqrt{\rho}$
integer :: idiag_etaj2max=0 ! DIAG_DOC: Max of artificial resistivity
! DIAG_DOC: $\eta\sim J^2 / \rho$
integer :: idiag_etajrhomax=0 ! DIAG_DOC: Max of artificial resistivity
! DIAG_DOC: $\eta\sim J / \rho$
integer :: idiag_etaaniso=0 ! DIAG_DOC: $\eta_1$
integer :: idiag_etaanisoBB=0 ! DIAG_DOC: $\eta_{BB}$
integer :: idiag_cosjbm=0 ! DIAG_DOC: $\left<\Jv\cdot\Bv/(|\Jv|\,|\Bv|)\right>$
integer :: idiag_coshjbm=0 ! DIAG_DOC:
integer :: idiag_jparallelm=0 ! DIAG_DOC: Mean value of the component
! DIAG_DOC: of J parallel to B
integer :: idiag_jperpm=0 ! DIAG_DOC: Mean value of the component
! DIAG_DOC: of J perpendicular to B
integer :: idiag_hjparallelm=0 ! DIAG_DOC: Mean value of the component
! DIAG_DOC: of $J_{\rm hyper}$ parallel to B
integer :: idiag_hjperpm=0 ! DIAG_DOC: Mean value of the component
! DIAG_DOC: of $J_{\rm hyper}$ perpendicular to B
integer :: idiag_brmsn=0,idiag_brmss=0,idiag_brmsh=0
integer :: idiag_b2sphm=0 ! DIAG_DOC: $\int_{r=0}^{r=r_{\rm diag}} \Bv^2 dV$,
! DIAG_DOC: where $r=\sqrt{x^2+y^2+z^2}$
integer :: idiag_brmsx=0 ! DIAG_DOC: $\left<\Bv^2\right>^{1/2}$ for
! DIAG_DOC: the magnetic_xaver_range
integer :: idiag_brmsz=0 ! DIAG_DOC: $\left<\Bv^2\right>^{1/2}$ for
! DIAG_DOC: the magnetic_zaver_range
integer :: idiag_Exmxy=0 ! DIAG_DOC: $\left<{\cal E}_x\right>_{z}$
integer :: idiag_Eymxy=0 ! DIAG_DOC: $\left<{\cal E}_y\right>_{z}$
integer :: idiag_Ezmxy=0 ! DIAG_DOC: $\left<{\cal E}_z\right>_{z}$
!
! phi averaged diagnostics given in phiaver.in
!
integer :: idiag_jxbrmphi=0 ! PHIAVG_DOC:
integer :: idiag_jxbpmphi=0 ! PHIAVG_DOC:
integer :: idiag_jxbzmphi=0 ! PHIAVG_DOC:
integer :: idiag_jbmphi=0 ! PHIAVG_DOC: $\left<\Jv\cdot\Bv\right>_\varphi$
integer :: idiag_armphi=0 ! PHIAVG_DOC:
integer :: idiag_apmphi=0 ! PHIAVG_DOC:
integer :: idiag_azmphi=0 ! PHIAVG_DOC:
integer :: idiag_brmphi=0 ! PHIAVG_DOC: $\left<B_\varpi\right>_\varphi$
! PHIAVG_DOC: [cyl.\ polar coords
! PHIAVG_DOC: $(\varpi,\varphi,z)$]
integer :: idiag_bpmphi=0 ! PHIAVG_DOC: $\left<B_\varphi\right>_\varphi$
integer :: idiag_bzmphi=0 ! PHIAVG_DOC: $\left<B_z\right>_\varphi$
integer :: idiag_br2mphi=0 ! PHIAVG_DOC: $\left<B^2_\varpi\right>_\varphi$
integer :: idiag_bp2mphi=0 ! PHIAVG_DOC: $\left<B^2_\varphi\right>_\varphi$
integer :: idiag_bz2mphi=0 ! PHIAVG_DOC: $\left<B^2_z\right>_\varphi$
! For the manual: bbmphi ! PHIAVG_DOC: shorthand for \var{brmphi},
! PHIAVG_DOC: \var{bpmphi} and \var{bzmphi}
! PHIAVG_DOC: together
! For the manual: bbsphmphi ! PHIAVG_DOC: shorthand for \var{brsphmphi},
! PHIAVG_DOC: \var{bthmphi} and \var{bpmphi}
! PHIAVG_DOC: together
integer :: idiag_b2mphi=0 ! PHIAVG_DOC: $\left<\Bv^2\right>_\varphi$
integer :: idiag_brsphmphi=0 ! PHIAVG_DOC: $\left<B_r\right>_\varphi$
integer :: idiag_bthmphi=0 ! PHIAVG_DOC: $\left<B_\vartheta\right>_\varphi$
integer :: idiag_uxbrmphi=0 ! PHIAVG_DOC:
integer :: idiag_uxbpmphi=0 ! PHIAVG_DOC:
integer :: idiag_uxbzmphi=0 ! PHIAVG_DOC:
integer :: idiag_brbpmphi=0 ! PHIAVG_DOC: $\left<B_\varpi B_\varphi\right>_\varphi$
integer :: idiag_brbzmphi=0 ! PHIAVG_DOC: $\left<B_\varpi B_z \right>_\varphi$
integer :: idiag_bpbzmphi=0 ! PHIAVG_DOC: $\left<B_\varphi B_z \right>_\varphi$
!
! xy averaged diagnostics given in xyaver.in
!
integer :: idiag_axmz=0 ! XYAVG_DOC: $\left<{\cal A}_x\right>_{xy}$
integer :: idiag_aymz=0 ! XYAVG_DOC: $\left<{\cal A}_y\right>_{xy}$
integer :: idiag_azmz=0 ! XYAVG_DOC: $\left<{\cal A}_z\right>_{xy}$
integer :: idiag_abuxmz=0 ! XYAVG_DOC: $\left<(\Av \cdot \Bv) u_x \right>_{xy}$
integer :: idiag_abuymz=0 ! XYAVG_DOC: $\left<(\Av \cdot \Bv) u_y \right>_{xy}$
integer :: idiag_abuzmz=0 ! XYAVG_DOC: $\left<(\Av \cdot \Bv) u_z \right>_{xy}$
integer :: idiag_uabxmz=0 ! XYAVG_DOC: $\left<(\uv \cdot \Av) B_x \right>_{xy}$
integer :: idiag_uabymz=0 ! XYAVG_DOC: $\left<(\uv \cdot \Av) B_y \right>_{xy}$
integer :: idiag_uabzmz=0 ! XYAVG_DOC: $\left<(\uv \cdot \Av) B_z \right>_{xy}$
integer :: idiag_bbxmz=0 ! XYAVG_DOC: $\left<{\cal B}'_x\right>_{xy}$
integer :: idiag_bbymz=0 ! XYAVG_DOC: $\left<{\cal B}'_y\right>_{xy}$
integer :: idiag_bbzmz=0 ! XYAVG_DOC: $\left<{\cal B}'_z\right>_{xy}$
integer :: idiag_bxmz=0 ! XYAVG_DOC: $\left<{\cal B}_x\right>_{xy}$
integer :: idiag_bymz=0 ! XYAVG_DOC: $\left<{\cal B}_y\right>_{xy}$
integer :: idiag_bzmz=0 ! XYAVG_DOC: $\left<{\cal B}_z\right>_{xy}$
integer :: idiag_jxmz=0 ! XYAVG_DOC: $\left<{\cal J}_x\right>_{xy}$
integer :: idiag_jymz=0 ! XYAVG_DOC: $\left<{\cal J}_y\right>_{xy}$
integer :: idiag_jzmz=0 ! XYAVG_DOC: $\left<{\cal J}_z\right>_{xy}$
integer :: idiag_Exmz=0 ! XYAVG_DOC: $\left<{\cal E}_x\right>_{xy}$
integer :: idiag_Eymz=0 ! XYAVG_DOC: $\left<{\cal E}_y\right>_{xy}$
integer :: idiag_Ezmz=0 ! XYAVG_DOC: $\left<{\cal E}_z\right>_{xy}$
integer :: idiag_bx2mz=0 ! XYAVG_DOC: $\left< B_x^2 \right>_{xy}$
integer :: idiag_by2mz=0 ! XYAVG_DOC: $\left< B_y^2 \right>_{xy}$
integer :: idiag_bz2mz=0 ! XYAVG_DOC: $\left< B_z^2 \right>_{xy}$
integer :: idiag_bx2rmz=0 ! XYAVG_DOC: $\left< B_x^2/\varrho \right>_{xy}$
integer :: idiag_by2rmz=0 ! XYAVG_DOC: $\left< B_y^2/\varrho \right>_{xy}$
integer :: idiag_bz2rmz=0 ! XYAVG_DOC: $\left< B_z^2/\varrho \right>_{xy}$
integer :: idiag_beta1mz=0 ! XYAVG_DOC: $\left< (B^2 / 2\mu_0) / p \right>_{xy}$
integer :: idiag_betamz = 0 ! XYAVG_DOC: $\langle\beta\rangle_{xy}$
integer :: idiag_beta2mz = 0 ! XYAVG_DOC: $\langle\beta^2\rangle_{xy}$
integer :: idiag_jbmz=0 ! XYAVG_DOC: $\left<\Jv\cdot\Bv\right>|_{xy}$
integer :: idiag_bdel2amz=0 ! XYAVG_DOC: $\left<\Bv\cdot\nabla^2\Av)\right>|_{xy}$
integer :: idiag_jdel2amz=0 ! XYAVG_DOC: $\left<\Jv\cdot\nabla^2\Av)\right>|_{xy}$
integer :: idiag_d6abmz=0 ! XYAVG_DOC: $\left<\nabla^6 \Av\cdot\Bv\right>|_{xy}$
integer :: idiag_d6amz1=0 ! XYAVG_DOC: $\left<\nabla^6 \Av \right>_{xy}|_x$
integer :: idiag_d6amz2=0 ! XYAVG_DOC: $\left<\nabla^6 \Av \right>_{xy}|_y$
integer :: idiag_d6amz3=0 ! XYAVG_DOC: $\left<\nabla^6 \Av \right>_{xy}|_z$
integer :: idiag_abmz=0 ! XYAVG_DOC: $\left<\Av\cdot\Bv\right>|_{xy}$
integer :: idiag_ubmz=0 ! XYAVG_DOC: $\left<\uv\cdot\Bv\right>|_{xy}$
integer :: idiag_ujmz=0 ! XYAVG_DOC: $\left<\uv\cdot\Jv\right>|_{xy}$
integer :: idiag_obmz=0 ! XYAVG_DOC: $\left<\ov\cdot\Bv\right>|_{xy}$
integer :: idiag_uamz=0 ! XYAVG_DOC: $\left<\uv\cdot\Av\right>|_{xy}$
integer :: idiag_bzuamz=0 ! XYAVG_DOC: $\left<B_z\uv\cdot\Av\right>|_{xy}$
integer :: idiag_bzaymz=0 ! XYAVG_DOC: $\left<B_z A_y\right>|_{xy}$
integer :: idiag_bzdivamz=0 ! XYAVG_DOC: $\left<B_z\nabla\cdot\Av\right>|_{xy}$
integer :: idiag_bzLammz=0 ! XYAVG_DOC: $\left<B_z\Lambda\right>|_{xy}$
integer :: idiag_divamz=0 ! XYAVG_DOC: $\left<\nabla\cdot\Av\right>|_{xy}$
integer :: idiag_uxbxmz=0 ! XYAVG_DOC: $\left<u_x b_x\right>|_{xy}$
integer :: idiag_uybxmz=0 ! XYAVG_DOC: $\left<u_y b_x\right>|_{xy}$
integer :: idiag_uzbxmz=0 ! XYAVG_DOC: $\left<u_z b_x\right>|_{xy}$
integer :: idiag_uxbymz=0 ! XYAVG_DOC: $\left<u_x b_y\right>|_{xy}$
integer :: idiag_uybymz=0 ! XYAVG_DOC: $\left<u_y b_y\right>|_{xy}$
integer :: idiag_uzbymz=0 ! XYAVG_DOC: $\left<u_z b_y\right>|_{xy}$
integer :: idiag_uxbzmz=0 ! XYAVG_DOC: $\left<u_x b_z\right>|_{xy}$
integer :: idiag_uybzmz=0 ! XYAVG_DOC: $\left<u_y b_z\right>|_{xy}$
integer :: idiag_uzbzmz=0 ! XYAVG_DOC: $\left<u_z b_z\right>|_{xy}$
integer :: idiag_ujxbmz=0 ! XYAVG_DOC: $\left<\uv\cdot(\Jv\times\Bv)\right>_{xy}$
integer :: idiag_examz1=0 ! XYAVG_DOC: $\left<\Ev\times\Av\right>_{xy}|_x$
integer :: idiag_examz2=0 ! XYAVG_DOC: $\left<\Ev\times\Av\right>_{xy}|_y$
integer :: idiag_examz3=0 ! XYAVG_DOC: $\left<\Ev\times\Av\right>_{xy}|_z$
integer :: idiag_exatotalmz1=0! XYAVG_DOC: $\left<\Ev\times\Av\right>_{xy}|_x$
integer :: idiag_exatotalmz2=0! XYAVG_DOC: $\left<\Ev\times\Av\right>_{xy}|_y$
integer :: idiag_exatotalmz3=0! XYAVG_DOC: $\left<\Ev\times\Av\right>_{xy}|_z$
integer :: idiag_e3xamz1=0 ! XYAVG_DOC: $\left<\Ev_{hyper3}\times\Av\right>_{xy}|_x$
integer :: idiag_e3xamz2=0 ! XYAVG_DOC: $\left<\Ev_{hyper3}\times\Av\right>_{xy}|_y$
integer :: idiag_e3xamz3=0 ! XYAVG_DOC: $\left<\Ev_{hyper3}\times\Av\right>_{xy}|_z$
integer :: idiag_etatotalmz=0 ! XYAVG_DOC: $\left<\eta\right>_{xy}$
integer :: idiag_ay2mz=0 ! XYAVG_DOC: $\left< A_y^2 \right>_{xy}$
integer :: idiag_aybxmz=0 ! XYAVG_DOC: $\left< A_y B_x \right>_{xy}$
integer :: idiag_bxbymz=0 ! XYAVG_DOC: $\left< B_x B_y \right>_{xy}$
integer :: idiag_bxbzmz=0 ! XYAVG_DOC: $\left< B_x B_z \right>_{xy}$
integer :: idiag_bybzmz=0 ! XYAVG_DOC: $\left< B_y B_z \right>_{xy}$
integer :: idiag_jxbrxmz=0 ! XYAVG_DOC:
integer :: idiag_jxbrymz=0 ! XYAVG_DOC:
integer :: idiag_jxbrzmz=0 ! XYAVG_DOC:
integer :: idiag_a2mz=0 ! XYAVG_DOC: $\left<\Av^2\right>_{xy}$
integer :: idiag_b2mz=0 ! XYAVG_DOC: $\left<\Bv^2\right>_{xy}$
integer :: idiag_bf2mz=0 ! XYAVG_DOC: $\left<\Bv'^2\right>_{xy}$
integer :: idiag_j2mz=0 ! XYAVG_DOC: $\left<\jv^2\right>_{xy}$
integer :: idiag_poynzmz=0 ! XYAVG_DOC: Averaged poynting flux in z direction
integer :: idiag_epsMmz=0 ! XYAVG_DOC: $\left<\eta\mu_0\jv^2\right>_{xy}$
integer :: idiag_vmagfricmz=0 ! XYAVG_DOC: $\left<1/\nu_{\rm mag}|\jv\times\Bv/\Bv^2|\right>_{xy}$
integer :: idiag_bxph1mz=0 ! XYAVG_DOC: $\left<{\cal B}_x\right>_{xy}|_{\rm phase 1}$
integer :: idiag_bxph2mz=0 ! XYAVG_DOC: $\left<{\cal B}_x\right>_{xy}|_{\rm phase 2}$
integer :: idiag_bxph3mz=0 ! XYAVG_DOC: $\left<{\cal B}_x\right>_{xy}|_{\rm phase 3}$
integer :: idiag_byph1mz=0 ! XYAVG_DOC: $\left<{\cal B}_y\right>_{xy}|_{\rm phase 1}$
integer :: idiag_byph2mz=0 ! XYAVG_DOC: $\left<{\cal B}_y\right>_{xy}|_{\rm phase 2}$
integer :: idiag_byph3mz=0 ! XYAVG_DOC: $\left<{\cal B}_y\right>_{xy}|_{\rm phase 3}$
integer :: idiag_bzph1mz=0 ! XYAVG_DOC: $\left<{\cal B}_z\right>_{xy}|_{\rm phase 1}$
integer :: idiag_bzph2mz=0 ! XYAVG_DOC: $\left<{\cal B}_z\right>_{xy}|_{\rm phase 2}$
integer :: idiag_bzph3mz=0 ! XYAVG_DOC: $\left<{\cal B}_z\right>_{xy}|_{\rm phase 3}$
integer :: idiag_bx2ph1mz=0 ! XYAVG_DOC: $\left<{\cal B}_x^2\right>_{xy}|_{\rm phase 1}$
integer :: idiag_bx2ph2mz=0 ! XYAVG_DOC: $\left<{\cal B}_x^2\right>_{xy}|_{\rm phase 2}$
integer :: idiag_bx2ph3mz=0 ! XYAVG_DOC: $\left<{\cal B}_x^2\right>_{xy}|_{\rm phase 3}$
integer :: idiag_by2ph1mz=0 ! XYAVG_DOC: $\left<{\cal B}_y^2\right>_{xy}|_{\rm phase 1}$
integer :: idiag_by2ph2mz=0 ! XYAVG_DOC: $\left<{\cal B}_y^2\right>_{xy}|_{\rm phase 2}$
integer :: idiag_by2ph3mz=0 ! XYAVG_DOC: $\left<{\cal B}_y^2\right>_{xy}|_{\rm phase 3}$
integer :: idiag_bz2ph1mz=0 ! XYAVG_DOC: $\left<{\cal B}_z^2\right>_{xy}|_{\rm phase 1}$
integer :: idiag_bz2ph2mz=0 ! XYAVG_DOC: $\left<{\cal B}_z^2\right>_{xy}|_{\rm phase 2}$
integer :: idiag_bz2ph3mz=0 ! XYAVG_DOC: $\left<{\cal B}_z^2\right>_{xy}|_{\rm phase 3}$
integer :: idiag_bx2rph1mz=0 ! XYAVG_DOC: $\left< B_x^2/\varrho \right>_{xy}|_{\rm phase 1}$
integer :: idiag_bx2rph2mz=0 ! XYAVG_DOC: $\left< B_x^2/\varrho \right>_{xy}|_{\rm phase 2}$
integer :: idiag_bx2rph3mz=0 ! XYAVG_DOC: $\left< B_x^2/\varrho \right>_{xy}|_{\rm phase 3}$
integer :: idiag_by2rph1mz=0 ! XYAVG_DOC: $\left< B_y^2/\varrho \right>_{xy}|_{\rm phase 1}$
integer :: idiag_by2rph2mz=0 ! XYAVG_DOC: $\left< B_y^2/\varrho \right>_{xy}|_{\rm phase 2}$
integer :: idiag_by2rph3mz=0 ! XYAVG_DOC: $\left< B_y^2/\varrho \right>_{xy}|_{\rm phase 3}$
integer :: idiag_bz2rph1mz=0 ! XYAVG_DOC: $\left< B_z^2/\varrho \right>_{xy}|_{\rm phase 1}$
integer :: idiag_bz2rph2mz=0 ! XYAVG_DOC: $\left< B_z^2/\varrho \right>_{xy}|_{\rm phase 2}$
integer :: idiag_bz2rph3mz=0 ! XYAVG_DOC: $\left< B_z^2/\varrho \right>_{xy}|_{\rm phase 3}$
integer :: idiag_abph1mz=0 ! XYAVG_DOC: $\left<\Av\cdot\Bv\right>|_{xy}|_{\rm phase 1}$
integer :: idiag_abph2mz=0 ! XYAVG_DOC: $\left<\Av\cdot\Bv\right>|_{xy}|_{\rm phase 2}$
integer :: idiag_abph3mz=0 ! XYAVG_DOC: $\left<\Av\cdot\Bv\right>|_{xy}|_{\rm phase 3}$
integer :: idiag_jbph1mz=0 ! XYAVG_DOC: $\left<\Jv\cdot\Bv\right>|_{xy}|_{\rm phase 1}$
integer :: idiag_jbph2mz=0 ! XYAVG_DOC: $\left<\Jv\cdot\Bv\right>|_{xy}|_{\rm phase 2}$
integer :: idiag_jbph3mz=0 ! XYAVG_DOC: $\left<\Jv\cdot\Bv\right>|_{xy}|_{\rm phase 3}$
integer :: idiag_poynzph1mz=0 ! XYAVG_DOC: Averaged poynting flux in z direction for phase 1
integer :: idiag_poynzph2mz=0 ! XYAVG_DOC: Averaged poynting flux in z direction for phase 2
integer :: idiag_poynzph3mz=0 ! XYAVG_DOC: Averaged poynting flux in z direction for phase 3
integer :: idiag_jxph1mz=0 ! XYAVG_DOC: $\left<{\cal J}_x\right>_{xy}|_{\rm phase 1}$
integer :: idiag_jxph2mz=0 ! XYAVG_DOC: $\left<{\cal J}_x\right>_{xy}|_{\rm phase 2}$
integer :: idiag_jxph3mz=0 ! XYAVG_DOC: $\left<{\cal J}_x\right>_{xy}|_{\rm phase 3}$
integer :: idiag_jyph1mz=0 ! XYAVG_DOC: $\left<{\cal J}_y\right>_{xy}|_{\rm phase 1}$
integer :: idiag_jyph2mz=0 ! XYAVG_DOC: $\left<{\cal J}_y\right>_{xy}|_{\rm phase 2}$
integer :: idiag_jyph3mz=0 ! XYAVG_DOC: $\left<{\cal J}_y\right>_{xy}|_{\rm phase 3}$
integer :: idiag_jzph1mz=0 ! XYAVG_DOC: $\left<{\cal J}_z\right>_{xy}|_{\rm phase 1}$
integer :: idiag_jzph2mz=0 ! XYAVG_DOC: $\left<{\cal J}_z\right>_{xy}|_{\rm phase 2}$
integer :: idiag_jzph3mz=0 ! XYAVG_DOC: $\left<{\cal J}_z\right>_{xy}|_{\rm phase 3}$
!
! xz averaged diagnostics given in xzaver.in
!
integer :: idiag_bxmy=0 ! XZAVG_DOC: $\left< B_x \right>_{xz}$
integer :: idiag_bymy=0 ! XZAVG_DOC: $\left< B_y \right>_{xz}$
integer :: idiag_bzmy=0 ! XZAVG_DOC: $\left< B_z \right>_{xz}$
integer :: idiag_bx2my=0 ! XZAVG_DOC: $\left< B_x^2 \right>_{xz}$
integer :: idiag_by2my=0 ! XZAVG_DOC: $\left< B_y^2 \right>_{xz}$
integer :: idiag_bz2my=0 ! XZAVG_DOC: $\left< B_z^2 \right>_{xz}$
integer :: idiag_bxbymy=0 ! XZAVG_DOC: $\left< B_x B_y \right>_{xz}$
integer :: idiag_bxbzmy=0 ! XZAVG_DOC: $\left< B_x B_z \right>_{xz}$
integer :: idiag_bybzmy=0 ! XZAVG_DOC: $\left< B_y B_z \right>_{xz}$
integer :: idiag_jxbrxmy=0 ! XZAVG_DOC:
integer :: idiag_jxbrymy=0 ! XZAVG_DOC:
integer :: idiag_jxbrzmy=0 ! XZAVG_DOC:
!
! yz averaged diagnostics given in yzaver.in
!
integer :: idiag_b2mx = 0 ! YZAVG_DOC: $\langle B^2\rangle_{yz}$
integer :: idiag_bxmx=0 ! YZAVG_DOC: $\left< B_x \right>_{yz}$
integer :: idiag_bymx=0 ! YZAVG_DOC: $\left< B_y \right>_{yz}$
integer :: idiag_bzmx=0 ! YZAVG_DOC: $\left< B_z \right>_{yz}$
integer :: idiag_bx2mx=0 ! YZAVG_DOC: $\left< B_x^2 \right>_{yz}$
integer :: idiag_by2mx=0 ! YZAVG_DOC: $\left< B_y^2 \right>_{yz}$
integer :: idiag_bz2mx=0 ! YZAVG_DOC: $\left< B_z^2 \right>_{yz}$
integer :: idiag_bxbymx=0 ! YZAVG_DOC: $\left<B_x B_y\right>_{yz}$
integer :: idiag_bxbzmx = 0 ! YZAVG_DOC: $\langle B_x B_z\rangle_{yz}$
integer :: idiag_bybzmx = 0 ! YZAVG_DOC: $\langle B_y B_z\rangle_{yz}$
integer :: idiag_betamx = 0 ! YZAVG_DOC: $\langle\beta\rangle_{yz}$
integer :: idiag_beta2mx = 0 ! YZAVG_DOC: $\langle\beta^2\rangle_{yz}$
integer :: idiag_etatotalmx=0 ! YZAVG_DOC: $\left<\eta\right>_{yz}$
integer :: idiag_jxbrxmx=0 ! YZAVG_DOC:
integer :: idiag_jxbrymx=0 ! YZAVG_DOC:
integer :: idiag_jxbrzmx=0 ! YZAVG_DOC:
!
! y averaged diagnostics given in yaver.in
!
integer :: idiag_b2mxz=0 ! YAVG_DOC: $\left< \Bv^2 \right>_{y}$
integer :: idiag_axmxz=0 ! YAVG_DOC: $\left< A_x \right>_{y}$
integer :: idiag_aymxz=0 ! YAVG_DOC: $\left< A_y \right>_{y}$
integer :: idiag_azmxz=0 ! YAVG_DOC: $\left< A_z \right>_{y}$
integer :: idiag_bx1mxz=0 ! YAVG_DOC: $\left<|B_x|\right>_{y}$
integer :: idiag_by1mxz=0 ! YAVG_DOC: $\left<|B_y|\right>_{y}$
integer :: idiag_bz1mxz=0 ! YAVG_DOC: $\left<|B_z|\right>_{y}$
integer :: idiag_bxmxz=0 ! YAVG_DOC: $\left< B_x \right>_{y}$
integer :: idiag_bymxz=0 ! YAVG_DOC: $\left< B_y \right>_{y}$
integer :: idiag_bzmxz=0 ! YAVG_DOC: $\left< B_z \right>_{y}$
integer :: idiag_jxmxz=0 ! YAVG_DOC: $\left< J_x \right>_{y}$
integer :: idiag_jymxz=0 ! YAVG_DOC: $\left< J_y \right>_{y}$
integer :: idiag_jzmxz=0 ! YAVG_DOC: $\left< J_z \right>_{y}$
integer :: idiag_bx2mxz=0 ! YAVG_DOC: $\left< B_x^2 \right>_{y}$
integer :: idiag_by2mxz=0 ! YAVG_DOC: $\left< B_y^2 \right>_{y}$
integer :: idiag_bz2mxz=0 ! YAVG_DOC: $\left< B_z^2 \right>_{y}$
integer :: idiag_bxbymxz=0 ! YAVG_DOC: $\left< B_x B_y \right>_{y}$
integer :: idiag_bxbzmxz=0 ! YAVG_DOC: $\left< B_x B_z \right>_{y}$
integer :: idiag_bybzmxz=0 ! YAVG_DOC: $\left< B_y B_z \right>_{y}$
integer :: idiag_uybxmxz=0 ! YAVG_DOC: $\left< U_y B_x \right>_{y}$
integer :: idiag_uybzmxz=0 ! YAVG_DOC: $\left< U_y B_z \right>_{y}$
integer :: idiag_Exmxz=0 ! YAVG_DOC: $\left<{\cal E}_x\right>_{y}$
integer :: idiag_Eymxz=0 ! YAVG_DOC: $\left<{\cal E}_y\right>_{y}$
integer :: idiag_Ezmxz=0 ! YAVG_DOC: $\left<{\cal E}_z\right>_{y}$
integer :: idiag_vAmxz=0 ! YAVG_DOC: $\left<v_A^2\right>_{y}$
!
! z averaged diagnostics given in zaver.in
!
integer :: idiag_bxmxy=0 ! ZAVG_DOC: $\left< B_x \right>_{z}$
integer :: idiag_bymxy=0 ! ZAVG_DOC: $\left< B_y \right>_{z}$
integer :: idiag_bzmxy=0 ! ZAVG_DOC: $\left< B_z \right>_{z}$
integer :: idiag_jxmxy=0 ! ZAVG_DOC: $\left< J_x \right>_{z}$
integer :: idiag_jymxy=0 ! ZAVG_DOC: $\left< J_y \right>_{z}$
integer :: idiag_jzmxy=0 ! ZAVG_DOC: $\left< J_z \right>_{z}$
integer :: idiag_axmxy=0 ! ZAVG_DOC: $\left< A_x \right>_{z}$
integer :: idiag_aymxy=0 ! ZAVG_DOC: $\left< A_y \right>_{z}$
integer :: idiag_azmxy=0 ! ZAVG_DOC: $\left< A_z \right>_{z}$
integer :: idiag_bx2mxy=0 ! ZAVG_DOC: $\left< B_x^2 \right>_{z}$
integer :: idiag_by2mxy=0 ! ZAVG_DOC: $\left< B_y^2 \right>_{z}$
integer :: idiag_bz2mxy=0 ! ZAVG_DOC: $\left< B_z^2 \right>_{z}$
integer :: idiag_bxbymxy=0 ! ZAVG_DOC: $\left< B_x B_y \right>_{z}$
integer :: idiag_bxbzmxy=0 ! ZAVG_DOC: $\left< B_x B_z \right>_{z}$
integer :: idiag_bybzmxy=0 ! ZAVG_DOC: $\left< B_y B_z \right>_{z}$
integer :: idiag_poynxmxy=0 ! ZAVG_DOC: $\left< \Ev\times\Bv \right>_{z}|_x$
integer :: idiag_poynymxy=0 ! ZAVG_DOC: $\left< \Ev\times\Bv \right>_{z}|_y$
integer :: idiag_poynzmxy=0 ! ZAVG_DOC: $\left< \Ev\times\Bv \right>_{z}|_z$
integer :: idiag_etatotalmxy=0 ! ZAVG_DOC: $\left<\eta\right>_{z}$
integer :: idiag_jbmxy=0 ! ZAVG_DOC: $\left< \Jv\cdot\Bv \right>_{z}$
integer :: idiag_abmxy=0 ! ZAVG_DOC: $\left< \Av\cdot\Bv \right>_{z}$
integer :: idiag_ubmxy=0 ! ZAVG_DOC: $\left< \Uv\cdot\Bv \right>_{z}$
integer :: idiag_examxy1=0 ! ZAVG_DOC: $\left< \Ev\times\Av \right>_{z}|_x$
integer :: idiag_examxy2=0 ! ZAVG_DOC: $\left< \Ev\times\Av \right>_{z}|_y$
integer :: idiag_examxy3=0 ! ZAVG_DOC: $\left< \Ev\times\Av \right>_{z}|_z$
integer :: idiag_StokesImxy=0 ! ZAVG_DOC: $\left< \epsilon_{B\perp} \right>_{z}|_z$
integer :: idiag_StokesQmxy=0 ! ZAVG_DOC: $-\left<\epsilon_{B\perp} \cos2\chi \right>_{z}|_z$
integer :: idiag_StokesUmxy=0 ! ZAVG_DOC: $-\left<\epsilon_{B\perp} \sin2\chi \right>_{z}|_z$
integer :: idiag_StokesQ1mxy=0! ZAVG_DOC: $+\left<F\epsilon_{B\perp} \sin2\chi \right>_{z}|_z$
integer :: idiag_StokesU1mxy=0! ZAVG_DOC: $-\left<F\epsilon_{B\perp} \cos2\chi \right>_{z}|_z$
integer :: idiag_beta1mxy=0 ! ZAVG_DOC: $\left< \Bv^2/(2\mu_0 p) \right>_{z}|_z$
integer :: idiag_dbxdxmxy=0
integer :: idiag_dbxdymxy=0
integer :: idiag_dbxdzmxy=0
integer :: idiag_dbydxmxy=0
integer :: idiag_dbydymxy=0
integer :: idiag_dbydzmxy=0
integer :: idiag_dbzdxmxy=0
integer :: idiag_dbzdymxy=0
integer :: idiag_dbzdzmxy=0
!
! Video data.
!
integer :: ivid_aps=0, ivid_bb=0, ivid_jj=0, ivid_b2=0, ivid_j2=0, ivid_ab=0, &
ivid_jb=0, ivid_beta1=0, ivid_poynting=0, ivid_bb_sph=0
!
! Auxiliary module variables
!
real, dimension(nx) :: eta_total=0.,eta_smag=0.,Fmax,dAmax,ssmax, &
diffus_eta=0.,diffus_eta2=0.,diffus_eta3=0.
!$omp threadprivate(eta_total)
real, dimension(nx,3) :: fres,forcing_rhs
real, dimension(nzgrid) :: eta_zgrid=0.0
real, dimension(mz) :: feta_ztdep=0.0
real :: eta_shock_jump1=1.0, eta_tdep=0.0, Arms=0.0
real, dimension(nx) :: eta_xtdep=0.0
real, dimension(-nghost:nghost,-nghost:nghost,-nghost:nghost) :: kern_jjsmooth
!
real, dimension(nz,nprocz) :: z_allprocs
!
! for continuous forcing
!
real, dimension (mx) :: phix,sinx,cosx
real, dimension (my) :: phiy,siny,cosy
real, dimension (mz) :: phiz,sinz,cosz
real :: R2,R12
real :: gamma, gamma1, gamma_m1
integer :: iedotx,iedotz
integer :: enum_tdep_eta_type = 0
integer :: enum_ambipolar_diffusion = 0
integer :: enum_rdep_profile = 0
integer :: enum_div_sld_magn = 0
integer :: enum_ihall_term = 0
integer :: enum_borderaa(3) = 0
integer :: enum_iforcing_continuous_aa = 0
!TP: moved here from saved variable
real, dimension(mz) :: Bz_stratified
logical :: lrelaxprof_glob_scaled
contains
!***********************************************************************
subroutine register_magnetic
!
! Initialise variables which should know that we solve for the vector
! potential: iaa, etc; increase nvar accordingly
!
! 01-may-02/wolf: coded
! 15-oct-15/MR: changes for slope-limited diffusion
! 03-apr-20/joern: restructured and fixed slope-limited diffusion
!
use Sub, only: register_report_aux
use FArrayManager, only: farray_register_pde, farray_register_auxiliary, farray_index_by_name_ode
use SharedVariables, only: put_shared_variable
!
call farray_register_pde('aa',iaa,vector=3)
iax = iaa; iay = iaa+1; iaz = iaa+2
!
! If we want to evolve the current density.
!
if (lohm_evolve) then
call farray_register_pde('jj',ijj,vector=3)
ijx = ijj; ijy = ijj+1; ijz = ijj+2
endif
!
! Identify version number.
!
if (lroot) call svn_id( &
"$Id$")
!
! Writing files for use with IDL
!
if (lroot) then
if (maux == 0) then
if (nvar < mvar) write(4,*) ',aa $'
if (nvar == mvar) write(4,*) ',aa'
else
write(4,*) ',aa $'
endif
write(15,*) 'aa = fltarr(mx,my,mz,3)*one'
endif
!
! Register EE as auxilliary array if asked for.
! This must not be involved when the displacement current is being solved for.
!
if (lee_as_aux) then !(AB: this will not be used; it was a test)
if (lroot) print*,'NOTE: lee_as_aux=',lee_as_aux
call farray_register_auxiliary('ee',iee,vector=3)
iex=iee; iey=iee+1; iez=iee+2
!
! Writing files for use with IDL
!
if (lroot) write(4,*) ',ee $'
if (lroot) write(15,*) 'ee = fltarr(mx,my,mz,3)*one'
endif
!
! Register an extra aux slot for bb if requested (so bb and jj are written
! to snapshots and can be easily analyzed later). For this to work you
! must reserve enough auxiliary workspace by setting, for example,
! ! MAUX CONTRIBUTION 6
! in the beginning of your src/cparam.local file, *before* setting
! ncpus, nprocy, etc.
!
! After a reload, we need to rewrite index.pro, but the auxiliary
! arrays are already allocated and must not be allocated again.
!
if (lbb_as_aux .or. lbb_as_comaux) &
call register_report_aux('bb', ibb, ibx, iby, ibz, communicated=lbb_as_comaux)
if (ljj_as_aux .or. ljj_as_comaux) &
call register_report_aux('jj', ijj, ijx, ijy, ijz, communicated=ljj_as_comaux)
!
if (lbbt_as_aux) then
call register_report_aux('bbt',ibbt,ibxt,ibyt,ibzt)
ltime_integrals=.true.
endif
!
if (ljjt_as_aux) then
call register_report_aux('jjt',ijjt,ijxt,ijyt,ijzt)
ltime_integrals=.true.
endif
!
if (lcoulomb) then
call register_report_aux('Lam', iLam,communicated=.true.)
call register_report_aux('diva', idiva,communicated=.true.)
endif
!
if (lua_as_aux ) call register_report_aux('ua',iua,communicated=.true.)
if (ljxb_as_aux) call register_report_aux('jxb',ijxb,ijxbx,ijxby,ijxbz)
if (luxb_as_aux) call register_report_aux('uxb',iuxb,iuxbx,iuxby,iuxbz)
if (lugb_as_aux) call register_report_aux('ugb',iugb,iugbx,iugby,iugbz)
if (lbgu_as_aux) call register_report_aux('bgu',ibgu,ibgux,ibguy,ibguz)
if (lbdivu_as_aux) call register_report_aux('bdivu',ibdivu,ibdivux,ibdivuy,ibdivuz)
!
!PJK: moved back to initialize_magnetic at least temporarily
! if (lbb_sph_as_aux) &
! call register_report_aux('bb_sph', ibb_sph, ibb_sphr, ibb_spht, ibb_sphp)
!
! Register va as auxilliary array if asked for also requires
! ! MAUX CONTRIBUTION 1
! ! COMMUNICATED AUXILIARIES 1
! in cparam.local
!
if (lalfven_as_aux) call register_report_aux('alfven',ialfven,communicated=.true.)
!
if (any(iresistivity=='eta-slope-limited')) then
lslope_limit_diff = .true.
if (dimensionality<3) lisotropic_advection=.true.
lbb_as_comaux=lsld_bb
if (isld_char == 0) then
call farray_register_auxiliary('sld_char',isld_char,communicated=.true.,on_gpu=lgpu)
if (lroot) write(15,*) 'sld_char= fltarr(mx,my,mz)*one'
aux_var(aux_count)=',sld_char'
if (naux+naux_com < maux+maux_com) aux_var(aux_count)=trim(aux_var(aux_count))//' $'
aux_count=aux_count+1
endif
endif
!
! Register nusmag as auxilliary variable
!
if (letasmag_as_aux.and.any(iresistivity=='smagorinsky')) then
call farray_register_auxiliary('etasmag',ietasmag,communicated=.true.)
if (lroot) write(15,*) 'etasmag = fltarr(mx,my,mz)*one'
aux_var(aux_count)=',etasmag'
if (naux+naux_com < maux+maux_com) aux_var(aux_count)=trim(aux_var(aux_count))//' $'
aux_count=aux_count+1
endif
!
! register the mean-field module
!
if (lmagn_mf) call register_magn_mf
!
! Share lbb_as_comaux with gravitational wave module.
!
call put_shared_variable('lbb_as_comaux',lbb_as_comaux, caller='register_magnetic')
call put_shared_variable('lresi_eta_tdep', lresi_eta_tdep)
if (lrun) call put_shared_variable('eta_tdep',eta_tdep)
call put_shared_variable('eta', eta)
call put_shared_variable('lohm_evolve', lohm_evolve)
call put_shared_variable('loverride_ee', loverride_ee)
!
! Share several parameters for Alfven limiter with module Shock.
!
if (lshock) then
call put_shared_variable('va2power_jxb', va2power_jxb)
call put_shared_variable('betamin_jxb', betamin_jxb)
endif
!
call put_shared_variable('rhoref', rhoref)
!
! Share lweyl_gauge
!
if (lspecial.or.lmagn_mf) call put_shared_variable('lweyl_gauge',lweyl_gauge)
!
call put_shared_variable('lfrozen_bb_bot',lfrozen_bb_bot)
call put_shared_variable('lfrozen_bb_top',lfrozen_bb_top)
!
! If meanfield theory is invoked, we need to tell the other routines
! eta is also needed with the chiral fluids procedure.
! Omit this now, because a few lines above we did this exact same line already.
! if (lrun .and. (lmagn_mf.or.lspecial)) call put_shared_variable('eta',eta)
!
! Share the external magnetic field with module Shear.
!
if (lmagn_mf.or.lshock .or. leos .or. lspecial) call put_shared_variable('B_ext', B_ext)
!
! Share the external magnetic field B_ext2 (used in mean field module and if conservative with hydro).
!
call put_shared_variable('B_ext2', B_ext2)
!
endsubroutine register_magnetic
!***********************************************************************
subroutine initialize_magnetic(f)
!
! Perform any post-parameter-read initialization
!
! 24-nov-02/tony: dummy routine - nothing to do at present
! 20-may-03/axel: reinitialize_aa added
! 13-jan-11/MR: use subroutine 'register_report_aux' instead of repeated code
! 26-feb-13/axel: reinitialize_aa added
! 21-jan-15/MR: avoided double put_shared_variable for B_ext
! 7-jun-16/MR: modifications in z average removal for Yin-Yang, yet inoperational
! 24-jun-17/MR: moved calculation of clight2_zdep from calc_pencils to initialize
! 28-feb-18/piyali: moved back the calculation of clight2_zdep to calc_pencils to use va2 pencil
!
use Sub, only: register_report_aux, write_zprof, step, get_smooth_kernel
use Magnetic_meanfield, only: initialize_magn_mf
use BorderProfiles, only: request_border_driving
use FArrayManager
use SharedVariables, only: get_shared_variable, put_shared_variable, iSHVAR_ERR_NOSUCHVAR
use EquationOfState, only: cs20, get_gamma_etc
use Initcond
use Forcing, only: n_forcing_cont
use Yinyang_mpi, only: initialize_zaver_yy
use Slices_methods, only: alloc_slice_buffers
!
real, dimension (mx,my,mz,mfarray) :: f
integer :: i, j, nyl, nycap, ierr
real :: eta_zdep_exponent
!
call get_gamma_etc(gamma)
gamma1=1./gamma; gamma_m1=gamma-1.
if (alev/=impossible) cdtf=alev
!
! To know whether we are solving the relativistic eos equations we need to get lrelativistic_eos from density.
!
if (ldensity) then
call get_shared_variable('lrelativistic_eos',lrelativistic_eos, caller='initialize_magnetic')
else
allocate(lrelativistic_eos)
lrelativistic_eos=.false.
endif
!
! Check if we are solving for relativistic bulk motions, not just EoS.
!
if (lhydro.and..not.lhydro_potential) then
call get_shared_variable('lconservative', lconservative, caller='initialize_magnetic')
else
allocate(lconservative)
lconservative=.false.
endif
!
!PJK: moved from register_magnetic at least temporarily
if (lbb_sph_as_aux) call register_report_aux('bb_sph', ibb_sph, ibb_sphr, ibb_spht, ibb_sphp)
!
! Set ljj_as_comaux=T and get kernels
! if lsmooth_jj is used
!
if(lsmooth_jj) then
ljj_as_comaux=lsmooth_jj
call get_smooth_kernel(kern_jjsmooth,LGAUSS=.true.)
endif
!
! Set initial value for alfven speed in farray if used
!
if (lalfven_as_aux) f(:,:,:,ialfven)=0.0
!
! Shear of B_ext,x is not implemented.
!
if (lshear .and. B_ext(1) /= 0.0) &
call warning('initialize_magnetic','B_ext,x /= 0 with shear is not implemented')
!
! Compute mask for x-averaging where x is in magnetic_xaver_range.
! Normalize such that the average over the full domain
! gives still unity.
!
if (l1 == l2) then
xmask_mag = 1.
else
where ( x(l1:l2) >= magnetic_xaver_range(1) &
.and. x(l1:l2) <= magnetic_xaver_range(2))
xmask_mag = 1.
elsewhere
xmask_mag = 0.
endwhere
xmask1_mag = xmask_mag
magnetic_xaver_range(1) = max(magnetic_xaver_range(1), xyz0(1))
magnetic_xaver_range(2) = min(magnetic_xaver_range(2), xyz1(1))
if (lspherical_coords) then
xmask_mag = xmask_mag * (xyz1(1)**3 - xyz0(1)**3) &
/ (magnetic_xaver_range(2)**3 - magnetic_xaver_range(1)**3)
elseif (lcylindrical_coords) then
xmask_mag = xmask_mag * (xyz1(1)**2 - xyz0(1)**2)&
/ (magnetic_xaver_range(2)**2 - magnetic_xaver_range(1)**2)
else
xmask_mag = xmask_mag*Lxyz(1)/(magnetic_xaver_range(2) - magnetic_xaver_range(1))
endif
endif
!
! Compute mask for z-averaging where z is in magnetic_zaver_range.
! Normalize such that the average over the full domain
! gives still unity.
!
if (n1 == n2) then
zmask_mag = 1.
else
where (z(n1:n2) >= magnetic_zaver_range(1) .and. z(n1:n2) <= magnetic_zaver_range(2))
zmask_mag = 1.
elsewhere
zmask_mag = 0.
endwhere
magnetic_zaver_range(1) = max(magnetic_zaver_range(1), xyz0(3))
magnetic_zaver_range(2) = min(magnetic_zaver_range(2), xyz1(3))
zmask_mag = zmask_mag*Lxyz(3)/(magnetic_zaver_range(2) - magnetic_zaver_range(1))
endif
!
! debug output
!
if (lroot.and.ip<14) then
print*,'xmask_mag=',xmask_mag
print*,'zmask_mag=',zmask_mag
endif
!
! Precalculate 1/mu (moved here from register.f90)
!
mu01=1./mu0
mu012=.5*mu01
!
! Precalculate eta if 1/eta (==eta1) is given instead
!
if (eta1/=0.) eta=1./eta1
!
! default to spread gradient over ~5 grid cells.
!
if (eta_rwidth == 0.) eta_rwidth = 5.*dx
!
! For two-step profiles, allow each step to have separate width. If not specified, take eta_rwidth.
!
if (eta_rwidth0==0.) eta_rwidth0 = eta_rwidth
if (eta_rwidth1==0.) eta_rwidth1 = eta_rwidth
!
! default to spread gradient over ~5 grid cells.
!
if (eta_xwidth == 0.) eta_xwidth = 5.*dx
!
! For two-step profiles, allow each step to have separate width. If not specified, take eta_xwidth.
!
if (eta_xwidth0==0.) eta_xwidth0 = eta_xwidth
if (eta_xwidth1==0.) eta_xwidth1 = eta_xwidth
!
! Precalculate 1/inertial_length^2
!
if (inertial_length/=0.0) then
linertial_2 = inertial_length**(-2)
else
linertial_2 = 0.0
! make sure not to use this value by checking that
! (inertial_length /= 0.)...
endif
!
! Precalculate 1/nu_ni
!
if (nu_ni/=0.0) then
lambipolar_diffusion=.true.
nu_ni1=1./nu_ni
else
nu_ni1=0.0
endif
!
! calculate B_ext21 = 1/B_ext**2 and the unit vector B1_ext = B_ext/|B_ext|
! Also calculate B_ext_inv = B_ext/|B_ext|^2
!
B_ext2=B_ext(1)**2+B_ext(2)**2+B_ext(3)**2
if (B_ext2/=0.0) then
B_ext21=1/B_ext2
else
B_ext21=1.0
endif
B_ext11=sqrt(B_ext21)
B1_ext=B_ext*B_ext11
B_ext_inv=B_ext*B_ext21
!
! Speed of light, sometimes used for displacement current correction
!
if (c_light/=impossible) then
c_light2=c_light**2
c_light21=1./c_light2
endif
!
! Compute exp_epspb=(gamma_epspb+1.)/4.
! Note that the extra 1/2 factor is because we work with B^2.
!
exp_epspb=(gamma_epspb+1.)/4.
!
! Calculate lJ_ext (true if any of the 3 components in true).
! MR: attention: this J_ext is added to the current density pencil with negative sign!
! only meaningful when meant for use with Bell instability
!
lJ_ext=any(J_ext/=0.)
!
! Reinitialize magnetic field using a small selection of perturbations
! that were mostly also available as initial conditions.
!
if (reinitialize_aa) then
do j=1,ninit
select case (initaa(j))
case ('rescale'); f(:,:,:,iax:iaz)=rescale_aa*f(:,:,:,iax:iaz)
case ('gaussian-noise'); call gaunoise(amplaa(j),f,iax,iaz)
case ('hor-tube'); call htube(amplaa(j),f,iax,iaz,radius,epsilonaa,center1_x,center1_z)
case ('cosxcosy'); call cosx_cosy_cosz(amplaa(j),f,iaz,kx_aa(j),ky_aa(j),kz_aa(j))
case ('coswave-Ay-kx'); call coswave(amplaa(j),f,iay,kx=kx_aa(j))
case ('sinwave-Ax-kz'); call sinwave(amplaa(j),f,iax,kz=kz_aa(j))
case ('toroidal'); f(:,:,:,iax)=-amplaa(j)*spread(spread( 1.0/x, 2,my),3,mz) &
*spread(spread( y, 1,mx),3,mz)
case default
endselect
enddo
endif
!
! set lrescaling_magnetic=T if linit_aa=T
!
if (lreset_aa) then
lrescaling_magnetic=.true.
endif
!
if (lfreeze_aint) lfreeze_varint(iax:iaz) = .true.
if (lfreeze_aext) lfreeze_varext(iax:iaz) = .true.
!
! Store spatially dependent external field in a global array
!
if (lbx_ext_global) call farray_register_global("global_bx_ext",iglobal_bx_ext)
if (lby_ext_global) call farray_register_global("global_by_ext",iglobal_by_ext)
if (lbz_ext_global) call farray_register_global("global_bz_ext",iglobal_bz_ext)
!
! Store spatially dependent external potential field in a global array
!
if (lax_ext_global) call farray_register_global("global_ax_ext",iglobal_ax_ext)
if (lay_ext_global) call farray_register_global("global_ay_ext",iglobal_ay_ext)
if (laz_ext_global) call farray_register_global("global_az_ext",iglobal_az_ext)
!
! Initialize resistivity.
!
if (iresistivity(1)=='') iresistivity(1)='eta-const' ! default
lresi_eta_const=.false.
lresi_eta_tdep=.false.
lresi_eta_xtdep=.false.
lresi_sqrtrhoeta_const=.false.
lresi_eta_aniso=.false.
lresi_hyper2=.false.
lresi_hyper3=.false.
lresi_hyper2_tdep=.false.
lresi_hyper3_tdep=.false.
lresi_hyper3_polar=.false.
lresi_hyper3_mesh=.false.
lresi_hyper3_csmesh=.false.
lresi_hyper3_strict=.false.
lresi_hyper3_aniso=.false.
lresi_eta_shock=.false.
lresi_eta_shock2=.false.
lresi_eta_shock_profz=.false.
lresi_eta_shock_profr=.false.
lresi_eta_shock_perp=.false.
lresi_etava=.false.
lresi_etaj=.false.
lresi_etaj2=.false.
lresi_etajrho=.false.
lresi_smagorinsky=.false.
lresi_smagorinsky_nusmag=.false.
lresi_smagorinsky_cross=.false.
lresi_anomalous=.false.
lresi_spitzer=.false.
lresi_cspeed=.false.
lresi_vAspeed=.false.
lresi_eta_proptouz=.false.
lmagnetic_slope_limited=.false.
!
do i=1,nresi_max
select case (iresistivity(i))
case ('eta-const')
if (lroot) print*, 'resistivity: constant eta'
lresi_eta_const=.true.
case ('eta-tdep')
if (lroot) print*, 'resistivity: time-dependent eta'
lresi_eta_tdep=.true.
case ('eta-xtdep')
if (lroot) print*, 'resistivity: x and t-dependent eta'
lresi_eta_xtdep=.true.
case ('eta-ztdep')
if (lroot) print*, 'resistivity: time-dependent eta'
lresi_eta_tdep=.true.
lresi_eta_ztdep=.true.
case ('sqrtrhoeta-const')
if (lroot) print*, 'resistivity: constant sqrt(rho)*eta'
lresi_sqrtrhoeta_const=.true.
case ('eta-aniso')
if (lroot) print*, 'resistivity: eta-aniso'
lresi_eta_aniso=.true.
if (eta1_aniso==impossible.and.eta1_aniso_ratio==impossible) then
call fatal_error('initialize_magnetic','eta1_aniso and eta1_aniso_ratio undefined')
elseif (eta1_aniso==impossible.and.eta1_aniso_ratio/=impossible) then
eta1_aniso=eta1_aniso_ratio*eta
endif
case ('etaSS')
if (lroot) print*, 'resistivity: etaSS (Shakura-Sunyaev)'
lresi_etaSS=.true.
case ('hyper2')
if (lroot) print*, 'resistivity: hyper2'
lresi_hyper2=.true.
case ('hyper3')
if (lroot) print*, 'resistivity: hyper3'
lresi_hyper3=.true.
case ('hyper2-tdep')
if (lroot) print*, 'resistivity: hyper2 (time-dependent)'
lresi_hyper2_tdep=.true.
case ('hyper3-tdep')
if (lroot) print*, 'resistivity: hyper3 (time-dependent)'
lresi_hyper3_tdep=.true.
case ('hyper3_cyl','hyper3-cyl','hyper3_sph','hyper3-sph')
if (lroot) print*, 'resistivity: hyper3 curvilinear'
lresi_hyper3_polar=.true.
case ('hyper3-mesh','hyper3_mesh')
if (lroot) print*, 'resistivity: hyper3 resolution-invariant'
lresi_hyper3_mesh=.true.
case ('hyper3-csmesh')
if (lroot) print*, 'resistivity: hyper3 cspeed resol-invariant'
lresi_hyper3_csmesh=.true.
case ('hyper3_strict')
if (lroot) print*, 'resistivity: strict hyper3 with positive definite heating rate'
lresi_hyper3_strict=.true.
case ('xydep')
if (lroot) print*, 'resistivity: xy-dependent'
lresi_xydep=.true.
call eta_xy_dep(eta_xy,geta_xy,eta_xy_profile)
case ('xdep','eta-xdep')
if (lroot) print*, 'resistivity: x-dependent'
lresi_xdep=.true.
call eta_xdep(eta_x,geta_x,xdep_profile)
case ('ydep','eta-ydep')
if (lroot) print*, 'resistivity: y-dependent'
lresi_ydep=.true.
call eta_ydep(ydep_profile, my, y, eta_y, geta_y)
case ('zdep','eta-zdep')
if (lroot) print*, 'resistivity: z-dependent'
lresi_zdep=.true.
call eta_zdep(zdep_profile, mz, z, eta_z, geta_z)
if (limplicit_resistivity) call eta_zdep(zdep_profile, nzgrid, zgrid, eta_zgrid)
case ('rdep','eta-rdep')
if (lroot) print*, 'resistivity: r-dependent'
lresi_rdep=.true.
case ('dust')
if (lroot) print*, 'resistivity: depending on dust density'
lresi_dust=.true.
case ('hyper3-aniso')
if (lroot) print*, 'resistivity: hyper3_aniso'
lresi_hyper3_aniso=.true.
case ('shell')
if (lroot) print*, 'resistivity: shell'
lresi_shell=.true.
case ('shock','eta-shock')
if (lroot) print*, 'resistivity: shock'
lresi_eta_shock=.true.
if (.not.lshock) call fatal_error('initialize_magnetic','shock resistivity, but SHOCK=noshock')
case ('eta-shock2')
if (lroot) print*, 'resistivity: shock'
lresi_eta_shock2=.true.
if (.not.lshock) call fatal_error('initialize_magnetic','shock resistivity, but SHOCK=noshock')
case ('eta-shock-profz')
if (lroot) print*, 'resistivity: shock with a vertical profile'
lresi_eta_shock_profz=.true.
if (.not.lshock) call fatal_error('initialize_magnetic','shock resistivity, but SHOCK=noshock')
case ('eta-shock-profr')
if (lroot) print*, 'resistivity: shock with a radial profile'
lresi_eta_shock_profr=.true.
if (.not.lshock) call fatal_error('initialize_magnetic','shock resistivity, but SHOCK=noshock')
case ('shock-perp')
if (lroot) print*, 'resistivity: shock perpendicular to B'
lresi_eta_shock_perp=.true.
if (.not.lshock) call fatal_error('initialize_magnetic','shock-perp resistivity, but SHOCK=noshock')
if (.not.ldivu_perp) &
call fatal_error('initialize_magnetic','shock-perp resistivity, but ldivu_perp=.false.')
case ('eta_va')
if (lroot) print*, 'resistivity: eta_va'
lresi_etava=.true.
case ('eta_j')
if (lroot) print*, 'resistivity: eta_j'
lresi_etaj=.true.
case ('eta_j2')
if (lroot) print*, 'resistivity: eta_j2'
lresi_etaj2=.true.
etaj20 = eta_j2 * mu0**2 * dxmax**3 / sqrt(cs20)
case ('eta_jrho')
if (lroot) print*, 'resistivity: eta_jrho'
lresi_etajrho=.true.
case ('smagorinsky')
if (lroot) print*, 'resistivity: smagorinsky'
lresi_smagorinsky=.true.
case ('smagorinsky-nusmag','smagorinsky_nusmag')
if (lroot) print*, 'resistivity: smagorinsky_nusmag'
lresi_smagorinsky_nusmag=.true.
case ('smagorinsky-cross')
if (lroot) print*, 'resistivity: smagorinsky_cross'
lresi_smagorinsky_cross=.true.
case ('anomalous')
if (lroot) print*, 'resistivity: anomalous'
lresi_anomalous=.true.
case ('spitzer','eta-spitzer')
if (lroot) print*, 'resistivity: temperature dependent (Spitzer 1969)'
lresi_spitzer=.true.
case ('eta-cspeed')
if (lroot) print*, 'resistivity: sound speed dependent e.g. SN driven ISM'
lresi_cspeed=.true.
case ('eta-vAspeed')
if (lroot) print*, 'resistivity: Alfven speed dependent e.g. SN driven ISM'
if (.not. lalfven_as_aux) call fatal_error('initialize_magnetic', &
'Alfven speed dependent resistivity, but not lalfven_as_aux=.true.')
lresi_vAspeed=.true.
case ('magfield')
if (lroot) print*, 'resistivity: magnetic field dependent'
lresi_magfield=.true.
case ('eta-proptouz')
if (lroot) print*, 'resistivity: eta proportional to uz'
lresi_eta_proptouz=.true.
case ('eta-slope-limited')
if (lroot) then
if (lsld_bb) then
print*,'resistivity: slope-limited diffusion on bb'
else
print*,'resistivity: slope-limited diffusion on aa'
endif
print*, 'resistivity: using ',trim(div_sld_magn),' order'
endif
lmagnetic_slope_limited=.true.
case ('none','')
! do nothing
case default
call fatal_error('initialize_magnetic','No such iresistivity('//trim(itoa(i))//'): '// &
trim(iresistivity(i)))
endselect
enddo
!
! The case tdep_eta_type='mean-field' is related to Schwinger effect, not to mean-field electrodynamics.
!
if (lresi_eta_tdep .or. lresi_eta_xtdep .or. lresi_hyper2_tdep .or. lresi_hyper3_tdep) then
if (tdep_eta_type=='mean-field'.or.tdep_eta_type=='mean-field-local') then
if (luse_scale_factor_in_sigma) then
if (ierr==iSHVAR_ERR_NOSUCHVAR) then
luse_scale_factor_in_sigma=.false.
else
call get_shared_variable('Hscript', Hscript, caller='initialize_magnetic')
endif
call get_shared_variable('echarge', echarge)
endif
if (luse_scale_factor_in_sigma) then
Hscript=1.
endif
endif
endif
!
! If lresi_eta_ztdep, compute z-dependent fraction here:
! It is called feta_ztdep, because it works only if lresi_eta_tdep.
! eta_zdep_exponent = (2/3)*hall_zdep_exponent; see Gourgouliatos+20.
!
if (lresi_eta_ztdep) then
if (Hhall==0.) call fatal_error('initialize_magnetic','Hhall=0 not allowed for lresi_eta_ztdep=T')
eta_zdep_exponent=(2./3.)*hall_zdep_exponent
feta_ztdep=1./(1.-(z-xyz1(3))/Hhall)**eta_zdep_exponent
endif
!
if (lyinyang) then
if (lresi_eta_shock_profz.or.lresi_xydep.or.lresi_ydep.or.lresi_zdep) &
call not_implemented('initialize_magnetic','y or z dependent profiles on Yin-Yang grid')
endif
if (lresi_eta_shock_profz .or. lresi_eta_shock_profr) then
eta_shock_jump1 = eta_shock*(eta_jump_shock-1.)
if (lresi_eta_shock_profz) &
call write_zprof('resi_shock', eta_shock + eta_shock_jump1*step(z(n1:n2), eta_zshock, -eta_width_shock))
endif
!
! for communication with testfield_general
!
lresi_dep(1:4) = (/lresi_xdep,lresi_ydep,lresi_zdep,lresi_xydep/)
!
! If we're timestepping, die or warn if the the resistivity coefficient that
! corresponds to the chosen resistivity type is not set.
!
if (lrun) then
if (lroot) then
if ((lresi_eta_const.or.lresi_eta_tdep).and.(eta==0.0)) then
if (.not.lresi_eta_xtdep) call warning('initialize_magnetic','Resistivity coefficient eta is zero')
endif
if (lresi_sqrtrhoeta_const.and.(eta==0.0)) &
call warning('initialize_magnetic','Resistivity coefficient eta is zero')
if (lresi_hyper2.and.eta_hyper2==0.0) &
call fatal_error('initialize_magnetic','Resistivity coefficient eta_hyper2 is zero')
if (lresi_hyper3.and.eta_hyper3==0.0) &
call fatal_error('initialize_magnetic','Resistivity coefficient eta_hyper3 is zero')
if (lresi_hyper3_polar.and.eta_hyper3==0.0) &
call fatal_error('initialize_magnetic','Resistivity coefficient eta_hyper3 is zero')
if (lresi_hyper3_mesh.and.eta_hyper3_mesh==0.0) &
call fatal_error('initialize_magnetic','Resistivity coefficient eta_hyper3_mesh is zero')
if (lresi_hyper3_csmesh.and.eta_hyper3_mesh==0.0) &
call fatal_error('initialize_magnetic','Resistivity coefficient eta_hyper3_mesh is zero')
if (lresi_hyper3_strict.and.eta_hyper3==0.0) &
call fatal_error('initialize_magnetic','Resistivity coefficient eta_hyper3 is zero')
if ( (lresi_hyper3_aniso) .and. &
((eta_aniso_hyper3(1)==0.0 .and. nxgrid/=1 ).or. &
(eta_aniso_hyper3(2)==0.0 .and. nygrid/=1 ).or. &
(eta_aniso_hyper3(3)==0.0 .and. nzgrid/=1 )) ) &
call fatal_error('initialize_magnetic','A resistivity coefficient of eta_aniso_hyper3 is zero')
if (lresi_eta_shock.and.eta_shock==0.0) &
call fatal_error('initialize_magnetic','Resistivity coefficient eta_shock is zero')
if (lresi_eta_shock2.and.eta_shock2==0.0) &
call fatal_error('initialize_magnetic','Resistivity coefficient eta_shock is zero')
if (lresi_eta_shock_profz.and.eta_shock==0.0) &
call fatal_error('initialize_magnetic','Resistivity coefficient eta_shock is zero')
if (lresi_eta_shock_profr.and.eta_shock==0.0) &
call fatal_error('initialize_magnetic','Resistivity coefficient eta_shock is zero')
if (lresi_eta_shock_perp.and.eta_shock==0.0) &
call fatal_error('initialize_magnetic','Resistivity coefficient eta_shock is zero')
if ((lresi_etava.or.lresi_vAspeed).and.eta_va==0.0) &
call fatal_error('initialize_magnetic','Resistivity coefficient eta_va is zero')
if (lresi_vAspeed.and.idiag_vArms==0) &
call fatal_error('initialize_magnetic','Resistivity requires vArms in print.in')
if (lresi_etaj .and. eta_j==0.0) &
call fatal_error('initialize_magnetic','Resistivity coefficient eta_j is zero')
if (lresi_etaj2 .and. eta_j2==0.0) &
call fatal_error('initialize_magnetic','Resistivity coefficient eta_j2 is zero')
if (lresi_etajrho .and. eta_jrho==0.0) &
call fatal_error('initialize_magnetic','Resistivity coefficient eta_jrho is zero')
if (lresi_anomalous.and.eta_anom==0.0) &
call fatal_error('initialize_magnetic','Resistivity coefficient eta_anom is zero')
! if (lentropy .and. lohmic_heat .and. .not. lresi_eta_const) &
! call fatal_error('initialize_magnetic', &
! 'Resistivity heating only works with regular resistivity')
if (lresi_hyper2.and.lresi_hyper3) &
call warning('initialize_magnetic','4th & 6th order hyperdiffusion are both set. '// &
'Timestep is currently only sensitive to fourth order')
endif
!
! Put eta_xtdep id lresi_eta_xtdep=T.
!
if (lresi_eta_xtdep) call put_shared_variable('eta_xtdep', eta_xtdep)
!
endif
!
! Quenching of \eta by rms of magnetic vector potential?
!
lquench_eta_aniso=(quench_aniso/=impossible)
if (.not.lquench_eta_aniso) then
idiag_etaaniso=0
idiag_etaanisoBB=0
endif
!
! precalculating fixed (on timescales larger than tau) vectorpotential
!
if (tau_relprof/=0.0) then
if (lyinyang) then
if (A_relaxprofile/='') call not_implemented('initialize_magnetic', &
'z dependent relaxation profiles for A on Yin-Yang grid')
endif
if (lA_relprof_global) then
if (iglobal_ax_ext==0 .and. iglobal_ay_ext==0 .and. iglobal_az_ext==0) then
call warning('initialize_magnetic', &
'lA_relprof_global=T but global A profile not existent - relaxation suppressed')
tau_relprof=0.
endif
else
lrelaxprof_glob_scaled=.false.
tau_relprof1=1./tau_relprof
select case (A_relaxprofile)
case('0,coskz,0')
A_relprof(:,1)=0.
A_relprof(:,2)=amp_relprof*cos(k_relprof*z(n1:n2))
A_relprof(:,3)=0.
case('sinkz,coskz,0')
A_relprof(:,1)=amp_relprof*sin(k_relprof*z(n1:n2))
A_relprof(:,2)=amp_relprof*cos(k_relprof*z(n1:n2))
A_relprof(:,3)=0.
case('aa_from_global')
lrelaxprof_glob_scaled = iglobal_ax_ext/=0 .or. iglobal_ay_ext/=0 .or. iglobal_az_ext/=0
if (.not.lrelaxprof_glob_scaled) call warning('initialize_magnetic', &
'lA_relprof_global=F and A_relaxprofile==aa_from_global, but global A profile not existent' // &
' - relaxation suppressed')
tau_relprof=0.
case default
call fatal_error('initialize_magnetic','no such A_relaxprofile: '//trim(A_relaxprofile))
endselect
call information('initialize_magnetic','set A_relaxprofile to: '//trim(A_relaxprofile))
endif
endif
!
! Write profile (uncomment for debugging)
!
! if (lfirst_proc_xy) then
! do n=1,mz
! write (100+iproc,*) z(n), eta_z(n), geta_z(n)
! enddo
! endif
!
! share eta profile with test-field procedure
!
if (ltestfield) then
if (lresi_xdep) then
call put_shared_variable('eta_x',eta_x,caller='initialize_magnetic')
call put_shared_variable('geta_x',geta_x)
endif
if (lresi_ydep) then
call put_shared_variable('eta_y',eta_y,caller='initialize_magnetic')
call put_shared_variable('geta_y',geta_y)
endif
if (lresi_zdep) then
call put_shared_variable('eta_z',eta_z,caller='initialize_magnetic')
call put_shared_variable('geta_z',geta_z)
endif
if (lresi_xydep) then
call put_shared_variable('eta_xy',eta_xy,caller='initialize_magnetic')
call put_shared_variable('geta_xy',geta_xy)
endif
endif
if (.not.lweyl_gauge) then
if (lresi_magfield) call fatal_error('initialize_magnetic','set lweyl_gauge=T for lresi_magfield')
if (lresi_etava) call not_implemented('initialize_magnetic','eta_va for resistive gauge')
endif
!
! get other shared variables
!
!AB call get_shared_variable('lrho_chi',lrho_chi, caller='initialize_magnetic')
!
! Border profile backward compatibility. For a vector, if only the first
! borderaa is set, then the other components get the same value.
!
if (lpropagate_borderaa .and. &
borderaa(1)/='nothing' .and. &
borderaa(2)=='nothing' .and. &
borderaa(3)=='nothing') then
borderaa(2)=borderaa(1)
borderaa(3)=borderaa(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 (borderaa(j))
case ('zero','0','initial-condition')
call request_border_driving(borderaa(j))
case ('nothing')
if (lroot.and.ip<=5) print*,"set_border_magnetic: borderaa='nothing'"
case default
call fatal_error('initialize_magnetic','No such borderaa: '//trim(borderaa(j)))
end select
enddo
!
! Initialize individual modules, but need to do this only if
! lmagn_mf is true.
!
if (lmagn_mf) call initialize_magn_mf(f)
!
! Calculate coskz and sinkz for calculating the phase of a Beltrami field
!
k1_ff_mag=k1_ff
if (idiag_bsinphz/=0 .or. idiag_bcosphz/=0 &
.or. idiag_uxbcmx/=0 .or. idiag_uxbcmy/=0 &
.or. idiag_uxbsmx/=0 .or. idiag_uxbsmy/=0 ) then
sinkz=sin(k1_ff_mag*z)
coskz=cos(k1_ff_mag*z)
endif
!
! When adding a magnetic field to a snapshot of a nomagnetic simulation,
! the code allows only the initialization of the field to zero. This
! hack allows a init_aa (from start.in) to be read and added to the
! field upon executing run.csh
!
if (lread_oldsnap_nomag.and.lrun_initaa) then
if (lroot) print*,'Adding a magnetic field to a previously '// &
'non-magnetic simulation. The field is given by initaa=',initaa
call init_aa(f)
endif
!
! Break if Galilean-invariant advection (fargo) is used without
! the advective gauge (only in run-time)
!
if (lrun.and.lfargo_advection) then
if (ladvective_gauge) then
if (.not.lupw_aa.and.linduction) then
if (any(B_ext/=0.)) call fatal_error("initialize_magnetic", &
"fargo advection with external field not tested")
if (lspherical_coords) call not_implemented('initialize_magnetic', &
"curvature terms on ajiuj for spherical coordinates and advective gauge")
endif
else
call fatal_error('initialize_magnetic','For fargo advection you need advective gauge. '// &
'Switch ladvective_gauge=T in magnetic_run_pars')
endif
endif
!
! Write constants to disk. In future we may want to deal with this
! using an include file or another module.
!
if (lroot) then
open (1,file=trim(datadir)//'/pc_constants.pro',position="append")
write (1,'(a,1pd26.16)') 'mu0=',mu0
close (1)
endif
!
if (.not.lforcing_cont) lforcing_cont_aa=.false.
if (lforcing_cont_aa) then
iforcing_cont_aa=min(n_forcing_cont,2)
if (iforcing_cont_aa==0) &
call fatal_error('initialize_magnetic','no valid continuous forcing available')
endif
if (lforcing_cont_aa_local) then
!
! sin and cos functions are calculated for all
! x,y,z points for use in integration
!
if (ip<=6) print*,'forcing_continuous: '//trim(iforcing_continuous_aa)
if (iforcing_continuous_aa=='fixed_swirl') then
if (lroot) print*,'forcing_continuous: fixed_swirl; swirl=',swirl
R2=radius**2
R12=1./R2
phix=exp(-R12*x**2)
phiy=exp(-R12*y**2)
phiz=exp(-R12*z**2)
elseif (iforcing_continuous_aa=='cosxcosz') then
cosx=cos(k1x_ff*x)
cosz=cos(k1z_ff*z)
elseif (iforcing_continuous_aa=='Azsinx') then
sinx=cos(k1z_ff*x)
elseif (iforcing_continuous_aa=='Aycosz') then
cosz=cos(k1z_ff*z)
elseif (iforcing_continuous_aa=='RobertsFlow') then
if (lroot) print*,'forcing_continuous: RobertsFlow'
sinx=sin(k1_ff_mag*x); cosx=cos(k1_ff_mag*x)
siny=sin(k1_ff_mag*y); cosy=cos(k1_ff_mag*y)
elseif (iforcing_continuous_aa=='Beltrami-z') then
if (lroot) print*,'forcing_continuous: Beltrami-z'
ampl_beltrami=ampl_ff
sinz=sin(k1_ff_mag*z+phase_beltrami)
cosz=cos(k1_ff_mag*z+phase_beltrami)
endif
endif
lcalc_aameanz = lcalc_aameanz.or.lremove_meanaz
if ((lspherical_coords.or.lcylindrical_coords).and.(lremove_meanax.or.lremove_meanaxy.or.lremove_meanaxz)) &
call warning('initialize_magnetic','removing x or x[yz] average not precise for curvilinear coordinates')
if (lspherical_coords.and.lremove_meanay) &
call warning('initialize_magnetic','removing y average not precise for spherical coordinates')
if (lremove_meanaxy) then
nyl=ny
if (lyinyang) then
call not_implemented('initialize_magnetic','Removal of z average for Yin-Yang')
call initialize_zaver_yy(nyl,nycap)
endif
if (.not.allocated(aamxy)) allocate(aamxy(nx,nyl))
endif
if (lremove_meanaxz.and..not.allocated(aamxz)) allocate(aamxz(nx,nz))
!
llorentz_rhoref = llorentzforce .and. rhoref/=impossible .and. rhoref>0.
if (llorentz_rhoref) rhoref1=1./rhoref
if (ivid_aps/=0) then
if (.not.(dimensionality==2) .or. .not.((lcylindrical_coords.and..not.lactive_dimension(2)) .or. &
(lspherical_coords .and..not.lactive_dimension(3)))) then
call warning('initialize_magnetic','aa_phi x (axis distance) on slices only implemented for axisymmetric setups')
ivid_aps=0
endif
if (lwrite_slice_xy .and..not.allocated(aps_xy ) ) allocate(aps_xy (nx,ny))
if (lwrite_slice_xz .and..not.allocated(aps_xz ) ) allocate(aps_xz (nx,nz))
if (lwrite_slice_yz .and..not.allocated(aps_yz ) ) allocate(aps_yz (ny,nz))
if (lwrite_slice_xz2.and..not.allocated(aps_xz2) ) allocate(aps_xz2(nx,nz))
endif
if (ivid_bb/=0) call alloc_slice_buffers(bb_xy,bb_xz,bb_yz,bb_xy2,bb_xy3,bb_xy4,bb_xz2,bb_r)
if (ivid_jj/=0) call alloc_slice_buffers(jj_xy,jj_xz,jj_yz,jj_xy2,jj_xy3,jj_xy4,jj_xz2,jj_r)
if (ivid_b2/=0) call alloc_slice_buffers(b2_xy,b2_xz,b2_yz,b2_xy2,b2_xy3,b2_xy4,b2_xz2,b2_r)
if (ivid_j2/=0) call alloc_slice_buffers(j2_xy,j2_xz,j2_yz,j2_xy2,j2_xy3,j2_xy4,j2_xz2,j2_r)
if (ivid_bb_sph/=0) &
call alloc_slice_buffers(bb_sph_xy,bb_sph_xz,bb_sph_yz,bb_sph_xy2,bb_sph_xy3,bb_sph_xy4,bb_sph_xz2,bb_sph_r)
if (ivid_ab/=0) call alloc_slice_buffers(ab_xy,ab_xz,ab_yz,ab_xy2,ab_xy3,ab_xy4,ab_xz2,ab_r)
if (ivid_jb/=0) call alloc_slice_buffers(jb_xy,jb_xz,jb_yz,jb_xy2,jb_xy3,jb_xy4,jb_xz2,jb_r)
if (ivid_beta1/=0) call alloc_slice_buffers(beta1_xy,beta1_xz,beta1_yz,beta1_xy2, &
beta1_xy3,beta1_xy4,beta1_xz2,beta1_r)
if (ivid_poynting/=0) call alloc_slice_buffers(poynting_xy,poynting_xz,poynting_yz,poynting_xy2, &
poynting_xy3,poynting_xy4,poynting_xz2,poynting_r)
!
z_allprocs=reshape(zgrid,(/nz,nprocz/))
if (.not.ltime_integrals_always.and.lvart_in_shear_frame) then
if (.not. lshear) &
call fatal_error('initialize_magnetic','lshear=F -> cannot do frame transform for time integrals')
!
! Must have nprocy=1 because we shift in the y direction
!
if (nprocy/=1) call fatal_error('initialize_magnetic','nprocy=1 required for lvart_in_shear_frame')
endif
!
! give warning if brms is not set in prints.in
!
if (bthresh_per_brms/=0.and.idiag_brms==0) then
call warning('initialize_magnetic','need to set brms in print.in to get bthresh. Disabled bthresh')
bthresh_per_brms=0.
endif
if (lmean_friction.and.nprocxy/=1) &
call fatal_error("initialize_magnetic","lmean_friction works only for nprocxy=1")
if (dipole_moment /= 0. .and. ladd_global_field) &
call fatal_error("initialize_magnetic", "Switch ladd_global_field=F if dipole_moment /= 0")
if (lcoulomb.and..not.lpoisson) &
call fatal_error('initialize_magnetic', 'Coulomb gauge needs the Poisson module')
if (.not.lcoulomb.and.idiag_bzLammz/=0) &
call fatal_error('initialize_magnetic', 'Coulomb gauge needs to be invoked for bzLamm')
iedotx=farray_index_by_name('eedot')
iedotz=iedotx+2
!
! set up z-stratification
!
if (B0_ext_z_H /= 0.) then
do iz = 1, mz
Bz_stratified(iz) = B0_ext_z * exp(-z(iz) / B0_ext_z_H)
enddo
else
Bz_stratified = 0.0
endif
endsubroutine initialize_magnetic
!***********************************************************************
subroutine initialize_magnetic_after_special
!
! 6-jun-25/TP: Introduced to get rid of this initialization out of the rhs
!
if (B0_ext_z /= 0.0) then
if (allocated (scale_height_init_z)) then
! set up z-stratification
do iz = 1, mz
Bz_stratified(iz) = B0_ext_z * exp(-z(iz) / scale_height_init_z(iz))
enddo
else
call fatal_error('initialize_magnetic_after_special','scale_height_init_z is not allocated')
endif
endif
endsubroutine initialize_magnetic_after_special
!***********************************************************************
subroutine init_aa(f)
!
! initialise magnetic field; called from start.f90
! We have an init parameter (initaa) to stear magnetic i.c. independently.
!
! 7-nov-2001/wolf: coded
!
use EquationOfState
use FArrayManager
use IO, only: input_snap, input_snap_finalize
use Gravity, only: gravz, z1, z2
use Initcond
use Boundcond
use InitialCondition, only: initial_condition_aa
use Mpicomm
use SharedVariables
use Sub
use General, only: yin2yang_coors, transform_thph_yy
use File_io, only: read_zaver
!
real, dimension (mx,my,mz,mfarray) :: f
!
real, dimension (mz) :: tmp
real, dimension (nx,3) :: bb
real, dimension (nx) :: b2,fact,cs2,lnrho_old,ssold,cs2old,x1,x2
real, dimension (nx) :: beq2_pencil, prof, tmpx
real, dimension (nx,ny) :: ax, ay
real, dimension(3) :: B_ext
real, dimension (:,:,:,:), allocatable :: ap
real, dimension (:,:), allocatable :: yz
real :: beq2,RFPradB12,RFPradJ12
real :: s,c,sph,sph_har_der
real :: cosalp, sinalp
integer :: j, iyz, llp1, l
logical :: lvectorpotential=.true.
!
do j=1,ninit
!
select case (initaa(j))
case ('nothing'); if (lroot .and. j==1) print*,'init_aa: nothing'
case ('zero', '0'); f(:,:,:,iax:iaz) = 0.0
case ('rescale'); f(:,:,:,iax:iaz)=amplaa(j)*f(:,:,:,iax:iaz)
case ('tanhxy'); call tanh_hyperbola(amplaa(j),f,iaa,sheet_position,sheet_thickness,sheet_hyp)
case ('exponential'); call exponential(amplaa(j),f,iaa,kz_aa(j))
case ('bsiny'); call acosy(amplaa(j),f,iaa,ky_aa(j))
case ('mode'); call modev(amplaa(j),coefaa,f,iaa,kx_aa(j),ky_aa(j),kz_aa(j))
case ('modeb'); call modeb(amplaa(j),coefbb,f,iaa,kx_aa(j),ky_aa(j),kz_aa(j))
case ('sph_constb'); call sph_constb(amplaa(j),f,iaa)
case ('const_lou'); call const_lou(amplaa(j),f,iaa)
case ('power_randomphase')
call power_randomphase(amplaa(j),initpower_aa,kgaussian_aa,kpeak_aa,cutoff_aa,f,iax,iaz,lscale_tobox)
case ('power_randomphase_hel')
call power_randomphase_hel(amplaa(j),initpower_aa,initpower2_aa, &
cutoff_aa,ncutoff_aa,kpeak_aa,f,iax,iaz,relhel_aa,kgaussian_aa, &
lskip_projection_aa, lvectorpotential, lscale_tobox, lsquash_aa, k1hel=k1hel, k2hel=k2hel, &
lpower_profile_file=lpower_profile_file, qexp=qexp_aa, nfact0=nfact_aa, lfactors0=lfactors_aa, &
l2d=l2d_aa,compk0=compk_aa, lrandom_ampl=lrandom_ampl_aa, lno_noise=lno_noise_aa)
case ('random-isotropic-KS')
call random_isotropic_KS(initpower_aa,f,iax,N_modes_aa)
case ('random_isotropic_shell')
call random_isotropic_shell(f,iax,amplaa(j),z1_aa,z2_aa)
case ('gaussian-noise'); call gaunoise(amplaa(j),f,iax,iaz)
case ('gaussian-noise-z'); call gaunoise(amplaa(j),f,iaz,iaz)
case ('gaussian-noise-rprof')
call gaunoise_rprof(amplaa(j),f,iax,iaz,rnoise_int,rnoise_ext)
case ('gaussian-noise-zprof')
tmp=amplaa(1)*0.5*(tanh((z-z1)/0.05)-tanh((z-z2)/0.05))
call gaunoise(tmp,f,iax,iaz)
case ('gaussian-noise-zprof2')
tmp=amplaa(1)*0.5*(tanh((z-znoise_int)/0.05)-tanh((z-znoise_ext)/0.05))
call gaunoise(tmp,f,iax,iaz)
!
! ABC field (includes Beltrami fields when only one coefficient /= 0)
!
case ('ABC_field')
call ABC_field(f,iaa,kx_aa(j),ky_aa(j),kz_aa(j),amplaa(j)*ABCaa,x0aa,y0aa,z0aa,widthaa,sigma=relhel_aa)
!
! Beltrami fields, put k=-k to make sure B=curl(A) has the right phase
!
case ('Beltrami-general'); call beltrami_general(amplaa(j),f,iaa,kx_aa(j),ky_aa(j),kz_aa(j),phase_aa(j))
case ('Beltrami-x'); call beltrami(amplaa(j),f,iaa,KX=kx_aa(j),phase=phasex_aa(j),sigma=relhel_aa)
case ('Beltrami-xy-samehel')
call beltrami(amplaa(j),f,iaa,KX=kx_aa(j),phase=phasex_aa(j),sigma=relhel_aa)
call beltrami(amplaa(j),f,iaa,KY=kx_aa(j),phase=phasex_aa(j),sigma=relhel_aa)
case ('Beltrami-xy-diffhel')
call beltrami(-amplaa(j),f,iaa,KX=kx_aa(j),phase=phasex_aa(j),sigma=relhel_aa)
call beltrami(amplaa(j),f,iaa,KY=kx_aa(j),phase=phasex_aa(j),sigma=relhel_aa)
case ('Beltrami-xy-mixed')
call beltrami(-amplaa(j)*mix_factor,f,iaa,KX=kx_aa(j),phase=phasex_aa(j),sigma=relhel_aa)
call beltrami(amplaa(j),f,iaa,KY=kx_aa(j),phase=phasex_aa(j),sigma=relhel_aa)
case ('Beltrami-yy')
call beltrami(amplaa(j),f,iaa,KX=kx_aa(j),phase=phasex_aa(j),sigma=relhel_aa)
call beltrami(amplaa(j),f,iaa,KX=2*kx_aa(j),phase=phasex_aa(j),sigma=relhel_aa)
case ('Beltrami-y'); call beltrami(amplaa(j),f,iaa,KY=ky_aa(j),phase=phasey_aa(j),sigma=relhel_aa)
case ('Beltrami-z'); call beltrami(amplaa(j),f,iaa,KZ=kz_aa(j),phase=phasez_aa(j), &
sigma=relhel_aa,z0=z0aa,width=widthaa(1))
case ('bihelical-z'); call bihelical(amplaa(j),f,iaa,KZ=kz_aa(j),phase=phasez_aa(j))
case ('bihelical-z-sym'); call bihelical(amplaa(j),f,iaa,KZ=kz_aa(j),phase=phasez_aa(j),sym=.true.)
case ('Beltrami-z-old'); call beltrami_old(amplaa(j),f,iaa,KZ=-kz_aa(j),phase=phasez_aa(j))
case ('Beltrami-z-complex'); call beltrami_complex(amplaa(j),f,iaa,KZ=-kz_aa(j),phase=phasez_aa(j))
case ('Beltrami-x-equ'); call beltrami(amplaa(j),f,iaa,KZ=-kz_aa(j),phase=phasez_aa(j),KX2=2*pi/Lxyz(1))
case ('Beltrami-y-equ'); call beltrami(amplaa(j),f,iaa,KZ=-kz_aa(j),phase=phasez_aa(j),KY2=2*pi/Lxyz(2))
case ('Beltrami-z-equ'); call beltrami(amplaa(j),f,iaa,KZ=-kz_aa(j),phase=phasez_aa(j),KZ2=2*pi/Lxyz(3))
!
case ('Bessel-x'); call bessel_x(amplaa(j),f,iaa,kx_aa(j))
case ('Bessel_Az-x'); call bessel_az_x(amplaa(j),f,iaa,kx_aa(j))
case ('propto-ux'); call wave_uu(amplaa(j),f,iaa,kx=kx_aa(j))
case ('propto-uy'); call wave_uu(amplaa(j),f,iaa,ky=ky_aa(j))
case ('propto-uz'); call wave_uu(amplaa(j),f,iaa,kz=kz_aa(j))
case ('diffrot'); call diffrot(amplaa(j),f,iay)
case ('ver-tube'); call vtube(amplaa(j),f,iax,iaz,radius)
case ('ver-tube-peri'); call vtube_peri(amplaa(j),f,iax,iaz,radius)
case ('hor-tanh'); call htanh(amplaa(j),f,iaz,epsilonaa)
case ('hor-tube'); call htube(amplaa(j),f,iax,iaz,radius,epsilonaa,center1_x,center1_z)
case ('hor-tube-x'); call htube_x(amplaa(j),f,iax,iaz,radius,epsilonaa,center1_y,center1_z)
case ('hor-tube_erf'); call htube_erf(amplaa(j),f,iax,iaz,radius,epsilonaa, &
center1_x,center1_z,fluxtube_border_width)
case ('hor-fluxlayer'); call hfluxlayer(amplaa(j),f,iaa,z0aa,widthaa(1))
case ('hor-fluxlayer-y'); call hfluxlayer_y(amplaa(j),f,iaa,z0aa,widthaa(1),ladd_bb_init)
case ('hor-fluxlayer-y-theta'); call hfluxlayer_y_theta(amplaa(j),f,iaa)
case ('ver-fluxlayer'); call vfluxlayer(amplaa(j),f,iaa,x0aa,widthaa(1))
case ('mag-support'); call magsupport(amplaa(j),f,gravz,sqrt(cs20),rho0)
case ('arcade-x'); call arcade_x(amplaa(j),f,iaa,kx_aa(j),kz_aa(j))
case ('halfcos-Bx'); call halfcos_x(amplaa(j),f,iaa)
case ('halfcos-Bz'); call halfcos_z(amplaa(j),f,iaa)
case ('uniform-Bx'); call uniform_x(amplaa(j),f,iaa)
case ('uniform-By'); call uniform_y(amplaa(j),f,iaa)
case ('uniform-Bz'); call uniform_z(amplaa(j),f,iaa)
case ('uniform-Bphi'); call uniform_phi(amplaa(j),f,iaa)
case ('phi_comp_over_r'); call phi_comp_over_r(amplaa(j),f,iaa)
case ('phi_comp_over_r_noise')
call phi_comp_over_r(amplaa(j),f,iaa)
call gaunoise(1.0e-5*amplaa(j),f,iax,iaz)
case ('Bz(x)', '3'); call vfield(amplaa(j),f,iaa)
case ('vfield2'); call vfield2(amplaa(j),f,iaa)
case ('bipolar'); call bipolar(amplaa(j),f,iaa,kx_aa(j),ky_aa(j),kz_aa(j))
case ('bipolar_restzero'); call bipolar_restzero(amplaa(j),f,iaa,kx_aa(j),ky_aa(j))
case ('vecpatternxy'); call vecpatternxy(amplaa(j),f,iaa,kx_aa(j),ky_aa(j),kz_aa(j))
case ('xjump'); call bjump(f,iaa,by_left,by_right,bz_left,bz_right,widthaa(1),'x')
case ('x-point_xy'); call xpoint(amplaa(j),f,iaz,center1_x,center1_y)
case ('x-point_xy2'); call xpoint2(amplaa(j),f,iaz,center1_x,center1_y)
case ('sinxsinz'); call sinxsinz(amplaa(j),f,iaa,kx_aa(j),ky_aa(j),kz_aa(j))
case ('Gaussian_By_z'); call Gaussian_By_z(amplaa(j),f,iaa,z0_gaussian(j),width_gaussian(j))
case ('bhyperz'); call bhyperz(amplaa(j),f,iaa,kz_aa(j),non_ffree_factor)
case ('sinxsinz_Hz'); call sinxsinz(amplaa(j),f,iaa,kx_aa(j),ky_aa(j),kz_aa(j),KKz=kz_aa(j))
case ('sin2xsin2y'); call sin2x_sin2y_cosz(amplaa(j),f,iaz,kx_aa(j),ky_aa(j),0.)
case ('cosxcosy'); call cosx_cosy_cosz(amplaa(j),f,iaz,kx_aa(j),ky_aa(j),0.)
case ('Bzcosxcosy'); call cosx_cosy_cosz(amplaa(j),f,iay,kx_aa(j),ky_aa(j),0.)
case ('sinxsiny'); call sinx_siny_cosz(amplaa(j),f,iaz,kx_aa(j),ky_aa(j),0.)
!!!case ('xsiny'); call x_siny_cosz(amplaa(j),f,iaz,kx_aa(j),ky_aa(j),0.,xbot=x0aa,nexp=nexp_aa)
case ('x1siny'); call x1_siny_cosz(amplaa(j),f,iaz,kx_aa(j),ky_aa(j),0.,phasey_aa(j))
case ('x32siny'); call x32_siny_cosz(amplaa(j),f,iaz,kx_aa(j),ky_aa(j),0.,phasey_aa(j))
case ('sinxcosz'); call sinx_siny_cosz(amplaa(j),f,iay,kx_aa(j),ky_aa(j),kz_aa(j))
case ('sinycosz'); call cosx_siny_cosz(amplaa(j),f,iax,kx_aa(j),ky_aa(j),0.)
case ('Ax_cosxcosycosz'); call cosx_cosy_cosz(amplaa(j),f,iax,kx_aa(j),ky_aa(j),0.)
case ('cosysinz'); call cosy_sinz(amplaa(j),f,iax,ky_aa(j),kz_aa(j))
case ('x3sinycosy'); call x3_siny_cosz(amplaa(j),f,iay,xyz0(1),xyz1(1),ky_aa(j),kz_aa(j))
case ('x3cosycosz'); call x3_cosy_cosz(amplaa(j),f,iax,ky_aa(j),kz_aa(j))
case ('Ax=cosysinz'); call cosy_sinz(amplaa(j),f,iax,ky_aa(j),kz_aa(j))
case ('magnetogram'); call mag_init(f)
case ('Bz_Az_file'); call mag_Az_init(f)
case ('Axyz_file'); call file_init(f)
case ('Bz-floor'); call mdi_init(f,.true.,z0aa)
case ('magnetogram_nonperiodic'); call mdi_init(f,.false.,z0aa)
case ('cosxcoscosy'); call cosx_coscosy_cosz(amplaa(j),f,iaz,kx_aa(j),ky_aa(j),0.)
case ('Bphi_cosy')
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iax)=amplaa(j)*(cos(2*pi*ky_aa(j)*(y(m)-y0)/Lxyz(2)))/Lxyz(2)
enddo; enddo
case ('Az_cosh2x1')
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iax)=0.
f(l1:l2,m,n,iay)=0.
f(l1:l2,m,n,iaz)=amplaa(j)/(cosh(x(l1:l2))*cosh(x(l1:l2)))
enddo; enddo
case ('By_sinx')
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iax)=0.
f(l1:l2,m,n,iay)=0.
f(l1:l2,m,n,iaz)=amplaa(j)*( cos(x(l1:l2)) )
enddo; enddo
case ('By_step')
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iax)=0.
f(l1:l2,m,n,iay)=0.
f(l1:l2,m,n,iaz)=2*amplaa(j)*step(x(l1:l2),xyz0(1)+Lxyz(1)/2.,widthaa(1)) - amplaa(j)
enddo; enddo
case ('By_tanh')
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iax)=0.
f(l1:l2,m,n,iay)=0.
f(l1:l2,m,n,iaz)=-amplaa(j)*alog(cosh(x(l1:l2)/widthaa(1)))/widthaa(1)
enddo; enddo
case ('crazy', '5'); call crazy(amplaa(j),f,iaa)
case ('strange'); call strange(amplaa(j),f,iaa)
case ('read_arr_file'); call read_outside_vec_array(f, "aa.arr", iaa)
case ('read_bin_file'); call read_outside_vec_array(f, "ap.dat", iaa,.true.,amplaa(j))
case ('sinwave-phase')
call sinwave_phase(f,iax,ampl_ax(j),kx_ax(j),ky_ax(j),kz_ax(j),phase_ax(j),LNORM_KK=lnorm_aa_kk)
call sinwave_phase(f,iay,ampl_ay(j),kx_ay(j),ky_ay(j),kz_ay(j),phase_ay(j),LNORM_KK=lnorm_aa_kk)
call sinwave_phase(f,iaz,ampl_az(j),kx_az(j),ky_az(j),kz_az(j),phase_az(j),LNORM_KK=lnorm_aa_kk)
case ('coswave-phase')
call coswave_phase(f,iax,ampl_ax(j),kx_ax(j),ky_ax(j),kz_ax(j),phase_ax(j),LNORM_KK=lnorm_aa_kk)
call coswave_phase(f,iay,ampl_ay(j),kx_ay(j),ky_ay(j),kz_ay(j),phase_ay(j),LNORM_KK=lnorm_aa_kk)
call coswave_phase(f,iaz,ampl_az(j),kx_az(j),ky_az(j),kz_az(j),phase_az(j),LNORM_KK=lnorm_aa_kk)
case ('sinwave-x'); call sinwave(amplaa(j),f,iaa,kx=kx_aa(j))
case ('coswave-Ax-kx'); call coswave(amplaa(j),f,iax,kx=kx_aa(j))
case ('coswave-Ax-ky'); call coswave(amplaa(j),f,iax,ky=ky_aa(j))
case ('coswave-Ax-kz'); call coswave(amplaa(j),f,iax,kz=kz_aa(j))
case ('coswave-Ay-kx'); call coswave(amplaa(j),f,iay,kx=kx_aa(j))
case ('coswave-Ay-ky'); call coswave(amplaa(j),f,iay,ky=ky_aa(j))
case ('coswave-Ay-kz'); call coswave(amplaa(j),f,iay,kz=kz_aa(j))
case ('coswave-Az-kx'); call coswave(amplaa(j),f,iaz,kx=kx_aa(j))
case ('coswave-Az-ky'); call coswave(amplaa(j),f,iaz,ky=ky_aa(j))
case ('coswave-Az-kz'); call coswave(amplaa(j),f,iaz,kz=kz_aa(j))
case ('sinwave-Ay-kz'); call sinwave_phase(f,iay,amplaa(j),kx_aa(j),ky_aa(j),kz_aa(j),phasez_aa(j))
case ('dipole'); call dipole(f,iax,amplaa(j))
case ('dipole-sph')
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iax)=0.
f(l1:l2,m,n,iay)=0.
f(l1:l2,m,n,iaz)=amplaa(j)*sin(y(m))*(xyz0(1)/x(l1:l2))**2.
enddo; enddo
case ('dipole_general'); call dipole(f,iax,amplaa(j),r_inner,r_outer)
case ('switchback'); call switchback(f,iax,amplaa(j),amplaa2(j),r_inner,r_outer)
case ('dipole_tor'); call dipole_tor(f,iax,amplaa(j)) !,ladd=.true.)
case ('linear-zx')
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iay)=-0.5*amplaa(j)*z(n)**2/Lxyz(3)
enddo; enddo
case ('spot_xy')
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iaz)=amplaa(j)*exp(-((x(l1:l2)-xyz1(1))**2+(y(m))**2)/radius**2)
enddo; enddo
case ('spot_xz')
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iay)=amplaa(j)*exp(-(x(l1:l2)**2+(z(n)-xyz1(3))**2)/radius**2)
enddo; enddo
case ('spot_spherical')
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iaz)=amplaa(j)*exp(-((x(l1:l2)-xyz1(1))**2)/0.04**2)* &
exp(-(y(m)-th_spot*pi/180.)**2/radius**2)
enddo; enddo
case ('Az=x2')
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iaz)=.25*pi_1*amplaa(j)*(x(l1:l2)/Lxyz(1))**2
enddo; enddo
case ('Ay=x')
!
! Initial Ay=r/2
!
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iay)=.5*amplaa(j)*x(l1:l2)
enddo; enddo
case ('Az=x4')
!
! Initial Az=(r/2)^2 [1-(r/2)^2] corresponds to Bphi=r/2 and Jz=1.
!
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iaz)=.25*amplaa(j)*x(l1:l2)**2*(1.-.25*x(l1:l2)**2)
enddo; enddo
case ('JzBz_cyl_ct')
!
! Initial Az=(r/2)^2 [1-(r/2)^2] corresponds to Bphi=r/2 and Jz=1.
!
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iaz)=-amplaaJ(j)*(x(l1:l2)**2)/4
f(l1:l2,m,n,iay)=amplaaB(j)*(x(l1:l2))/2
enddo; enddo
case ('JzBz_cyl_ct_sq')
!
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iaz)=-amplaaJ(j)*(x(l1:l2)**2)/4
f(l1:l2,m,n,iay)=amplaaB(j)*x(l1:l2)/2*(RFPrad(j)**2-x(l1:l2)**2/2)
enddo; enddo
!
! (work in progress, koen 14/03/11)
!
case ('JzBz_cyl_4_4')
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iaz)=-amplaaJ(j)/4*x(l1:l2)**2*(RFPrad(j)**4-x(l1:l2)**4/9)
f(l1:l2,m,n,iay)=amplaaB(j)/2*x(l1:l2)*(RFPrad(j)**4-x(l1:l2)**4/3)
enddo; enddo
!
! Uniform B-field in cylindrical coordinates
!
case ('Bz=const(cyl)')
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iay)=.5*x(l1:l2)*amplaaB(j)
enddo; enddo
!
! Logarithmic B-spiral in cylindrical coordinates
!
case ('Bspiral(cyl)')
cosalp=cos(alp_aniso*dtor)
sinalp=sin(alp_aniso*dtor)
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iax)=+amplaa(j)*sinalp*x(l1:l2)*cos(kz_aa(j)*z(n))
f(l1:l2,m,n,iay)=-amplaa(j)*cosalp*x(l1:l2)*cos(kz_aa(j)*z(n))
f(l1:l2,m,n,iaz)=0.
enddo; enddo
!
! generalized
!
case ('JzBz_cyl_RFPradJB')
RFPradB12=1./RFPradB
RFPradJ12=1./RFPradJ
x1=x(l1:l2)
x2=x(l1:l2)**2
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iay)=+.50*amplaaB(j)*x1*(1.-.50*x2*RFPradB12)
f(l1:l2,m,n,iaz)=-.25*amplaaJ(j)*x2*(1.-.25*x2*RFPradJ12)
enddo; enddo
!
case ('Magnetosonic-x'); call magnetosonic_x(amplaa(j),f,iuu,iaa,ilnrho,kx_aa(j),mu0)
case ('Alfven-x'); call alfven_x(amplaa(j),f,iuu,iaa,ilnrho,kx_aa(j),mu0)
case ('Alfven-y'); call alfven_y(amplaa(j),f,iuu,iaa,ky_aa(j),mu0)
case ('Alfven-z'); call alfven_z(amplaa(j),f,iuu,iaa,kz_aa(j),mu0)
case ('Alfven-xy'); call alfven_xy(amplaa(j),f,iuu,iaa,kx_aa(j),ky_aa(j),mu0)
case ('Alfven-xz'); call alfven_xz(amplaa(j),f,iuu,iaa,kx_aa(j),kz_aa(j),mu0)
case ('Alfvenz-rot'); call alfvenz_rot(amplaa(j),f,iuu,iaa,kz_aa(j),Omega)
case ('Alfvenz-bell'); call alfvenz_bell(amplaa(j),f,iuu,iaa,kz_aa(j),B_ext(3),J_ext(3))
case ('Alfvenz-rot-shear'); call alfvenz_rot_shear(amplaa(j),f,iuu,iaa,kz_aa(j),Omega)
case ('piecewise-dipole'); call piecew_dipole_aa (amplaa(j),inclaa,f,iaa)
case ('Ferriere-uniform-Bx'); call ferriere_uniform_x(amplaa(j),f,iaa)
case ('Ferriere-uniform-By'); call ferriere_uniform_y(amplaa(j),f,iaa)
case ('robertsflow'); call robertsflow(amplaa(j),f,iaa,relhel_aa,KX=kx_aa(j),FLOW=robflow_aa(j))
case ('rotated_robertsflow'); call rotated_robertsflow(amplaa(j),f,iaa,relhel_aa,KX=kx_aa(j),FLOW=robflow_aa(j))
case ('sinx-clip')
do l=l1,l2
if (abs(x(l))<=pi) then
f(l,:,:,iay)=amplaa(j)*sin(x(l))
else
f(l,:,:,iay)=0.
endif
enddo
case ('tony-nohel')
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iay)=amplaa(j)/kz_aa(j)*cos(kz_aa(j)*2.*pi/Lz*z(n))
enddo;enddo
case ('tony-nohel-yz')
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iay)=amplaa(j)/kx_aa(j)*sin(kx_aa(j)*2.*pi/Lx*x(l1:l2))
enddo;enddo
case ('tony-hel-xy')
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iax)=amplaa(j)/kz_aa(j)*sin(kz_aa(j)*2.*pi/Lz*z(n))
f(l1:l2,m,n,iay)=amplaa(j)/kz_aa(j)*cos(kz_aa(j)*2.*pi/Lz*z(n))
enddo;enddo
case ('tony-hel-yz')
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iay)=amplaa(j)/kx_aa(j)*sin(kx_aa(j)*2.*pi/Lx*x(l1:l2))
f(l1:l2,m,n,iaz)=amplaa(j)/kx_aa(j)*cos(kx_aa(j)*2.*pi/Lx*x(l1:l2))
enddo;enddo
case ('force-free-jet')
lB_ext_pot=.true.
call force_free_jet(mu_ext_pot)
!
! planar
!
case ('planar')
if (lroot) print*,'init_aa: planar'
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iax)=amplaa(j)*(z(n)**4/4.-z(n)**3/3.)*x(l1:l2)**2*(x(l1:l2)-1.)
f(l1:l2,m,n,iay)=amplaa(j)*z(n)*(z(n)-1.)*x(l1:l2)*(x(l1:l2)-1.)*relhel_aa
enddo;enddo
!
! Circularly polarised Alfven wave in x direction.
!
case ('Alfven-circ-x')
if (lroot) print*,'init_aa: circular Alfven wave -> x'
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iay) = amplaa(j)/kx_aa(j)*sin(kx_aa(j)*x(l1:l2))
f(l1:l2,m,n,iaz) = amplaa(j)/kx_aa(j)*cos(kx_aa(j)*x(l1:l2))
enddo;enddo
case ('geo-benchmark-case1','geo-benchmark-case2'); call geo_benchmark_B(f)
!
case ('torus-test'); call torus_test(amplaa(j),f,kx_aa(j),ky_aa(j))
!
! test case horizontal dipole for spherical shell polar boundary conditions
!
case ('horizontal_dipole')
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iax) = 0.
f(l1:l2,m,n,iay) = - amplaa(j)*x(l1:l2)*sin(z(n))
f(l1:l2,m,n,iaz) = - amplaa(j)*x(l1:l2)*cos(y(m))*cos(z(n))
enddo; enddo
!
! test case vertical dipole for spherical shell polar boundary conditions
!
case ('vertical_dipole')
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iax) = 0.
f(l1:l2,m,n,iay) = 0.
f(l1:l2,m,n,iaz) = amplaa(j)*x(l1:l2)*sin(y(m))
enddo; enddo
!
case ('relprof')
do n=n1,n2
f(l1:l2,m1:m2,n,iax)=A_relprof(n-nghost,1)
f(l1:l2,m1:m2,n,iay)=A_relprof(n-nghost,2)
enddo
!
case ('inclined-dipole')
!
! Inclined dipole initial condition. In principle can use precession as well (though for that it should be moved to
! runtime). Works only for spherical coordinates, and needs global external storing of fields.
!
if (.not.(lbx_ext_global.and.lby_ext_global.and.lbz_ext_global)) &
call fatal_error("init_aa","inclined-dipole: switch lb[xyz]_ext_global=T in magnetic_start_pars")
if (.not.lspherical_coords) &
call not_implemented("init_aa","inclined-dipole for other than spherical coordinates")
!
c=cos(inclaa*pi/180); s=sin(inclaa*pi/180)
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iglobal_bx_ext) = dipole_moment * 2*(c*costh(m) + s*sinth(m)*cos(z(n)))/x(l1:l2)**3
f(l1:l2,m,n,iglobal_by_ext) = dipole_moment * (c*sinth(m) - s*costh(m)*cos(z(n)))/x(l1:l2)**3
f(l1:l2,m,n,iglobal_bz_ext) = dipole_moment * (s*sin(z(n))) /x(l1:l2)**3
enddo;enddo
!
case ('Axy_from_file') !(prelim version to set Ax,Ay on one proc)
open(1,file='Axy.dat',form='unformatted')
read(1) ax,ay
close(1)
f(l1:l2,m1:m2,n1,iax)=ax*amplaa(1)
f(l1:l2,m1:m2,n1,iay)=ay*amplaa(1)
!
case ('A_from_file') !(prelim version to set Ax,Ay on one proc)
if (.not.allocated(ap)) allocate(ap(nx,ny,nz,3))
open(1,file='aa.dat',form='unformatted')
read(1) ap
close(1)
f(l1:l2,m1:m2,n1:n2,iax)=ap(:,:,:,1)*amplaa(1)
f(l1:l2,m1:m2,n1:n2,iay)=ap(:,:,:,2)*amplaa(1)
f(l1:l2,m1:m2,n1:n2,iaz)=ap(:,:,:,3)*amplaa(1)
if (allocated(ap)) deallocate(ap)
!
case ('B_ext_from_file')
if (.not.allocated(ap)) allocate(ap(mx,my,mz,6))
call input_snap('ap.dat',ap,6,0)
call input_snap_finalize
!
if (iglobal_ax_ext/=0) f(:,:,:,iglobal_ax_ext) = ap(:,:,:,1)
if (iglobal_ay_ext/=0) f(:,:,:,iglobal_ay_ext) = ap(:,:,:,2)
if (iglobal_az_ext/=0) f(:,:,:,iglobal_az_ext) = ap(:,:,:,3)
!
if (iglobal_bx_ext/=0) f(:,:,:,iglobal_bx_ext) = ap(:,:,:,4)
if (iglobal_by_ext/=0) f(:,:,:,iglobal_by_ext) = ap(:,:,:,5)
if (iglobal_bz_ext/=0) f(:,:,:,iglobal_bz_ext) = ap(:,:,:,6)
call initiate_isendrcv_bdry(f)
call finalize_isendrcv_bdry(f)
if (allocated(ap)) deallocate(ap)
!
case('spher-harm-poloidal')
if (.not.lspherical_coords) call fatal_error("init_uu", &
"'spher-harm-poloidal' only meaningful for spherical coordinates")
tmpx=(x(l1:l2)-xyz0(1))*(x(l1:l2)-xyz1(1))/x(l1:l2) + (xyz1(1) - 0.5*xyz0(1)) ! S/r
prof=3.*(x(l1:l2)-xyz0(1)) ! S' + S/r
llp1=(ll_sh(j)+1)*ll_sh(j)
if (lyang) then
allocate(yz(2,nyz))
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
bb(:,1)=amplaa(j)*llp1*tmpx*ylm_other(yz(1,iyz),yz(2,iyz),ll_sh(j),mm_sh(j),sph_har_der)
bb(:,2)=amplaa(j)*prof*sph_har_der
if (mm_sh(j)/=0) then
bb(:,3) = -amplaa(j)*prof*mm_sh(j)/sin(yz(1,iyz))*sin(yz(2,iyz))/cos(yz(2,iyz))
else
bb(:,3) = 0.
endif
call transform_thph_yy( bb, (/1,1,1/), f(l1:l2,m,n,iax:iaz), yz(1,iyz), yz(2,iyz) )
iyz=iyz+1
enddo
enddo
else
do n=n1,n2
do m=m1,m2
sph=ylm(ll_sh(j),mm_sh(j),sph_har_der)
f(l1:l2,m,n,iax) = amplaa(j)*llp1*tmpx*sph
f(l1:l2,m,n,iay) = amplaa(j)*prof*sph_har_der
if (mm_sh(j)/=0) & ! as phi-dependence is cos(m*phi)
f(l1:l2,m,n,iaz) = -amplaa(j)*prof*mm_sh(j)*sph/sinth(m)*sin(mm_sh(j)*z(n))/cos(mm_sh(j)*z(n))
enddo
enddo
endif
case('from-zaverage')
call read_zaver(f,iax,iaz,source_zav,nzav,indzav)
case default
call fatal_error('init_aa','no such init_aa: "'//trim(initaa(j))//'"')
endselect
!
! End loop over initial conditions.
!
enddo
!
! Initialize individual modules, but need to do this only if
! lmagn_mf is true.
!
if (lmagn_mf) call init_aa_mf(f)
!
! Interface for user's own initial condition.
!
if (linitial_condition) call initial_condition_aa(f)
!
! Set diva=0 when lcoulomb=T
!
if (idiva/=0) f(:,:,:,idiva)=0.
!
! In 2-D with nzgrid=1, setting Ax=Ay=0 makes sense, but shouldn't
! be compulsory, so allow for this possibility in 2-D.
!
if (lset_AxAy_zero) then
if (nzgrid==1) then
f(:,:,:,iax:iay)=0.0
else
call fatal_error("init_aa","lset_AxAy_zero=T only allowed with nzgrid=1")
endif
endif
!
! Allow for pressure equilibrium (for isothermal tube)
! assume that ghost zones have already been set.
! corrected expression below for gamma /= 1 case.
! The beq2 expression for 2*mu0*p is not general yet.
!
if (lpress_equil.or.lpress_equil_via_ss) then
if (lroot) print*,'init_aa: adjust lnrho to have pressure equilib; cs20=',cs20
call boundconds_x(f)
call initiate_isendrcv_bdry(f)
call finalize_isendrcv_bdry(f)
call boundconds_y(f)
call boundconds_z(f)
!
call get_gamma_etc(gamma,cp=cp)
!
do n=n1,n2
do m=m1,m2
call curl(f,iaa,bb)
call dot2_mn(bb,b2)
if (gamma==1.0) then
f(l1:l2,m,n,ilnrho)=log(exp(f(l1:l2,m,n,ilnrho))-b2/(2.*cs20))
else
beq2=2.*rho0*cs20
fact=max(1.0e-6,1.0-b2/beq2)
if (lentropy.and.lpress_equil_via_ss) then
if (lpress_equil_alt) then
ssold=f(l1:l2,m,n,iss)
cs2old=cs20*exp(gamma_m1*(f(l1:l2,m,n,ilnrho)-lnrho0) + gamma/cp*ssold) ! generalised for cp /= 1
cs2=cs2old-gamma*b2/(beq2*exp(f(l1:l2,m,n,ilnrho)-lnrho0))
f(l1:l2,m,n,iss)=ssold+cp*gamma1*(log(cs2/cs20)-log(cs2old/cs20)) ! generalised for cp /= 1
else
f(l1:l2,m,n,iss)=f(l1:l2,m,n,iss)+fact/gamma
endif
else
if (lpress_equil_alt) then
lnrho_old=f(l1:l2,m,n,ilnrho)
cs2=cs20*exp(gamma_m1*(lnrho_old-lnrho0) + gamma/cp*f(l1:l2,m,n,iss)) ! generalised for cp /= 1
f(l1:l2,m,n,ilnrho)=log(exp(lnrho_old)-b2*gamma/(2.*cs2))
f(l1:l2,m,n,iss)=cp*gamma1*(log(cs2/cs20)- & ! generalised for cp /= 1
gamma_m1*(f(l1:l2,m,n,ilnrho)-lnrho0)) ! lnrho0 added for generality
else
!f(l1:l2,m,n,ilnrho)=f(l1:l2,m,n,ilnrho)+fact/gamma_m1
beq2_pencil=2.*rho0*cs20*exp(gamma*(f(l1:l2,m,n,ilnrho)-lnrho0))
fact=max(1.0e-6,1.0-b2/beq2_pencil)
f(l1:l2,m,n,ilnrho)=f(l1:l2,m,n,ilnrho)+alog(fact)/gamma
endif
endif
endif
enddo
enddo
!
endif
!
! Add magnetic energy to T00 [needed in conservative (relativistic) case].
! Currently only the imposed field is added.
!
if (lconservative) then
f(:,:,:,irho)=f(:,:,:,irho)+.5*B_ext2
if (lroot) print*,'added to T00: .5*B_ext2= ', .5*B_ext2
endif
!
! Initialize current to zero, if lohm_evolve=T.
!
if (lohm_evolve) then
f(l1:l2,:,:,ijx:ijz)=0.
endif
!
endsubroutine init_aa
!***********************************************************************
subroutine pencil_criteria_magnetic
!
! All pencils that the Magnetic module depends on are specified here.
!
! 19-nov-04/anders: coded
!
! Always request aa, because it is such a triviality...
!
lpenc_requested(i_aa)=.true.
lpenc_requested(i_bb)=.true.
if (.not.ladvective_gauge) lpenc_requested(i_uxb)=.true.
!
! We'd also need uxb when computing the displacement current, so:
!
if (iex>0) lpenc_requested(i_uxb)=.true.
!
! need uga always for advective gauge.
!
if (ladvective_gauge) then
if (lfargo_advection) then
lpenc_requested(i_uuadvec_gaa)=.true.
else
lpenc_requested(i_uga)=.true.
endif
endif
!
if (tauAD/=0.0) then
lpenc_requested(i_jxb)=.true.
lpenc_requested(i_jxbxb)=.true.
lpenc_requested(i_b2)=.true.
endif
!
! anisotropic B-dependent diffusivity
!
if (eta_aniso_BB/=0.0) then
lpenc_requested(i_jb)=.true.
lpenc_requested(i_bb)=.true.
lpenc_requested(i_b2)=.true.
endif
!
! magneto friction model
!
if (lmagneto_friction) then
lpenc_requested(i_jxbxb)=.true.
lpenc_requested(i_b2)=.true.
lpenc_requested(i_jxb)=.true.
endif
!
if (lwrite_slices) then
if (ivid_aps/=0) then
lpenc_video(i_aps)=.true.
lpenc_video(i_rcyl_mn)=.true.
endif
if (ivid_bb/=0) lpenc_video(i_bb)=.true.
if (ivid_jj/=0) lpenc_video(i_jj)=.true.
if (ivid_b2/=0) lpenc_video(i_b2)=.true.
if (ivid_j2/=0) lpenc_video(i_j2)=.true.
if (ivid_bb_sph/=0) lpenc_video(i_bb_sph)=.true.
if (ivid_jb/=0) lpenc_video(i_jb)=.true.
if (ivid_ab/=0) lpenc_video(i_ab)=.true.
if (ivid_beta1/=0) lpenc_video(i_beta1)=.true.
if (ivid_poynting/=0) then
lpenc_video(i_uxb)=.true.
lpenc_video(i_jxb)=.true.
endif
endif
!
if ((lresi_eta_const.or.lresi_eta_tdep) .and. .not. lweyl_gauge &
.and. .not. limplicit_resistivity) lpenc_requested(i_del2a) = .true.
!
if (lresi_zdep) then
if (.not. limplicit_resistivity) lpenc_requested(i_del2a) = .true.
lpenc_requested(i_diva) = .true.
endif
!
! jj pencil always needed when in Weyl gauge
! (unless we solve for the displacement current)
!
if ((hall_term/=0.0.and.ldt).or.height_eta/=0.0.or.ip<=4.or. &
lweyl_gauge.or.lspherical_coords.or.lJ_ext.or.ljj_as_aux.or. &
lresi_eta_aniso) &
lpenc_requested(i_jj)=.true.
if (battery_term/=0.0) then
lpenc_requested(i_fpres)=.true.
lpenc_requested(i_glnrho)=.true.
endif
if ((.not.lweyl_gauge).and.(lresi_shell.or. &
lresi_eta_shock.or.lresi_smagorinsky.or.lresi_smagorinsky_nusmag.or. &
lresi_eta_shock2.or.lresi_xdep.or.lresi_ydep.or.lresi_xydep.or. &
lresi_rdep.or.lresi_eta_shock_profz.or.lresi_eta_shock_profr.or. &
lresi_smagorinsky_cross.or.lresi_spitzer.or. &
lresi_eta_proptouz)) &
lpenc_requested(i_del2a)=.true.
if (lresi_rdep) then
lpenc_requested(i_r_mn)=.true.
lpenc_requested(i_r_mn1)=.true.
endif
if (lresi_ydep .and. lspherical_coords) lpenc_requested(i_r_mn1)=.true.
if ((.not.lweyl_gauge).and.(lresi_eta_proptouz)) lpenc_requested(i_diva)=.true.
if (lhydro) lpenc_requested(i_uij)=.true.
if (lresi_eta_proptouz) lpenc_requested(i_uu)=.true.
if (lresi_sqrtrhoeta_const) then
lpenc_requested(i_jj)=.true.
lpenc_requested(i_rho1)=.true.
if (.not.lweyl_gauge) then
lpenc_requested(i_del2a)=.true.
lpenc_requested(i_glnrho)=.true.
endif
endif
if (lresi_eta_shock.or.lresi_eta_shock_profz.or.lresi_eta_shock2.or.lresi_eta_shock_profr) then
lpenc_requested(i_shock)=.true.
if (.not.lweyl_gauge) then
lpenc_requested(i_gshock)=.true.
lpenc_requested(i_diva)=.true.
endif
endif
if (lresi_etava) then
lpenc_requested(i_etava)=.true.
lpenc_requested(i_jj)=.true.
endif
if (lresi_etaj) then
lpenc_requested(i_etaj)=.true.
lpenc_requested(i_jj)=.true.
endif
if (lresi_etaj2) then
lpenc_requested(i_etaj2)=.true.
lpenc_requested(i_jj)=.true.
endif
if (lresi_etajrho) then
lpenc_requested(i_etajrho)=.true.
lpenc_requested(i_jj)=.true.
endif
if (lresi_shell) then
lpenc_requested(i_r_mn)=.true.
lpenc_requested(i_evr)=.true.
endif
if (lresi_eta_shock_profr) then
lpenc_requested(i_r_mn)=.true.
endif
if (lresi_eta_shock_perp) then
lpenc_requested(i_shock_perp)=.true.
if (.not.lweyl_gauge) then
lpenc_requested(i_gshock_perp)=.true.
lpenc_requested(i_diva)=.true.
endif
endif
if (lresi_spitzer.or.lresi_cspeed) then
lpenc_requested(i_lnTT)=.true.
if (lweyl_gauge) then
lpenc_requested(i_jj)=.true.
else
lpenc_requested(i_glnTT)=.true.
lpenc_requested(i_del2a)=.true.
lpenc_requested(i_diva)=.true.
endif
endif
if (lresi_vAspeed) then
lpenc_requested(i_etava)=.true.
lpenc_requested(i_va2)=.true.
if (lweyl_gauge) then
lpenc_requested(i_jj)=.true.
else
lpenc_requested(i_gva)=.true.
lpenc_requested(i_del2a)=.true.
lpenc_requested(i_diva)=.true.
endif
endif
!
! for Coulomb gauge
!
if (lcoulomb) then
lpenc_requested(i_diva)=.true.
if (idiag_gLamam/=0 .or. idiag_gLambm/=0 &
.or. lcoulomb_apply) lpenc_requested(i_gLam)=.true.
endif
!
! Pencils requested for diamagnetism
!
if (ldiamagnetism) then
lpenc_requested(i_b2)=.true.
lpenc_requested(i_bij)=.true.
lpenc_requested(i_jj)=.true.
endif
!
! For diagnostics u.grad(b)
!
if (lugb_as_aux) then
lpenc_requested(i_ugb)=.true.
lpenc_requested(i_bij)=.true.
endif
!
if (lupw_aa) then
lpenc_requested(i_uu)=.true.
lpenc_requested(i_aij)=.true.
endif
if (tau_relprof/=0 .or. ekman_friction_aa/=0) then
lpenc_requested(i_aa)=.true.
endif
if (ladvective_gauge) then
lpenc_requested(i_aa)=.true.
lpenc_requested(i_uu)=.true.
lpenc_requested(i_aij)=.true.
lpenc_requested(i_uij)=.true.
endif
!
! For diagnostics b.grad(u) and div(u)b
!
if (lbgu_as_aux) then
lpenc_requested(i_bgu)=.true.
lpenc_requested(i_uij)=.true.
endif
if (lbdivu_as_aux) then
lpenc_requested(i_bdivu)=.true.
lpenc_requested(i_divu)=.true.
endif
!
if (lresi_shell.or.lresi_xdep.or.lresi_ydep.or.lresi_xydep.or. &
lresi_rdep.or.lresi_smagorinsky.or.lresi_smagorinsky_nusmag) &
lpenc_requested(i_diva)=.true.
if (lresi_smagorinsky_nusmag) lpenc_requested(i_nu_smag)=.true.
if (lresi_smagorinsky_cross) lpenc_requested(i_jo)=.true.
if (lresi_hyper2 .or. lresi_hyper2_tdep) lpenc_requested(i_del4a)=.true.
if (lresi_hyper3 .or. lresi_hyper3_tdep) lpenc_requested(i_del6a)=.true.
if (lresi_hyper3_csmesh) lpenc_requested(i_cs2)=.true.
if (lrhs_max.and.lhydro) lpenc_requested(i_uu)=.true.
!
! Note that for the cylindrical case, according to lpencil_check,
! graddiva is not needed. We still need it for the lspherical_coords
! case, although we should check this.
! del2a now computed directly in all spherical so not required
! if (lspherical_coords) lpenc_requested(i_graddiva)=.true.
!
if (lentropy .or. lresi_smagorinsky .or. ltemperature) then
lpenc_requested(i_j2)=.true.
endif
if (lresi_dust) lpenc_requested(i_rhop)=.true.
if (lresi_anomalous) then
lpenc_requested(i_jj)=.true.
lpenc_requested(i_rho1)=.true.
endif
!
! when b2 is needed for quenching factors
!
if (J_ext_quench/=0) lpenc_requested(i_b2)=.true.
!
! Pencils needed by thermodynamics.
!
if (lentropy .or. ltemperature .or. lhydro) lpenc_requested(i_rho1)=.true.
if (lentropy .or. ltemperature) lpenc_requested(i_TT1)=.true.
if (lrhs_max.and.lentropy) lpenc_requested(i_cv1)=.true.
if (ltemperature) lpenc_requested(i_cv1)=.true.
if (lenergy .and. .not. lkinematic .and. lohmic_heat) then
lpenc_requested(i_j2)=.true.
if (lentropy .and. pretend_lnTT) lpenc_requested(i_cv1)=.true.
endif
!
! Ambipolar diffusion.
!
if (lambipolar_diffusion) then
lpenc_requested(i_nu_ni1)=.true.
lpenc_requested(i_va2)=.true.
lpenc_requested(i_jxbrxb)=.true.
lpenc_requested(i_jxbr2)=.true.
lpenc_requested(i_jxbr)=.true.
if (ambipolar_diffusion=="ionization-equilibrium") lpenc_requested(i_rho1)=.true.
if (ambipolar_diffusion=="ionization-yH") then
lpenc_requested(i_yH)=.true.
lpenc_requested(i_rho1)=.true.
endif
endif
!
if (llocal_friction) then
lpenc_requested(i_aa)=.true.
endif
!
if (hall_term/=0.0) lpenc_requested(i_jxb)=.true.
!
if (ldiamagnetism) lpenc_requested(i_gb22)=.true.
!
! Take care of Lorentz force for potential flows.
! In that case, use only the magnetic pressure.
!
if (lhydro .and. llorentzforce) then
if (iphiuu==0) then !MR???
lpenc_requested(i_jxbr)=.true.
else
lpenc_requested(i_b2)=.true.
endif
endif
!
if (lresi_smagorinsky_cross) lpenc_requested(i_oo)=.true.
!
if (dipole_moment/=0.0) lpenc_requested(i_r_mn1)=.true.
!
! pencils for semirelativistic Boris correction to velocity eq.
!
if (lboris_correction) then
lpenc_requested(i_jxbr)=.true.
lpenc_requested(i_bb)=.true.
lpenc_requested(i_u2)=.true.
lpenc_requested(i_cs2)=.true.
lpenc_requested(i_gamma_A2)=.true.
lpenc_requested(i_rho1)=.true.
lpenc_requested(i_rho1gpp)=.true.
lpenc_requested(i_ugu)=.true.
endif
!
if (lmagneto_friction.and.(.not.lhydro)) lpenc_requested(i_vmagfric)=.true.
!
! ua pencil if lua_as_aux
!
if (lua_as_aux) lpenc_diagnos(i_ua)=.true. !MR: diagnostics pencil???
!
! e2 and b2 needed for mean-field conductivity
!
if (lresi_eta_tdep .or. lresi_eta_xtdep .or. lresi_hyper2_tdep .or. lresi_hyper3_tdep) then
if (tdep_eta_type=='mean-field-local') then
lpenc_requested(i_b2)=.true.
endif
endif
!
! Request unit vectors for transformation of magnetic field from
! Cartesian to spherical coordinates.
!
if (lbb_sph_as_aux.and.lsphere_in_a_box) then
lpenc_requested(i_bb)=.true.
lpenc_requested(i_evr)=.true.
lpenc_requested(i_evth)=.true.
lpenc_requested(i_phix)=.true.
lpenc_requested(i_phiy)=.true.
endif
!
! diagnostics pencils
!
if (idiag_jxmax/=0 .or. idiag_jymax/=0 .or. idiag_jzmax/=0) lpenc_diagnos(i_jj)=.true.
if (idiag_jxbxm/=0 .or. idiag_jybxm/=0 .or. idiag_jzbxm/=0 .or. idiag_jxbym/=0 .or. &
idiag_jxbzm/=0 .or. idiag_jybzm/=0 .or. idiag_jzbzm/=0) lpenc_diagnos(i_jj)=.true.
if (idiag_jxbrxm/=0 .or. idiag_jxbrym/=0 .or. idiag_jxbrzm/=0 .or. idiag_jxbrqm/=0) &
lpenc_diagnos(i_jxbr)=.true.
if (idiag_jxbrmax/=0) lpenc_diagnos(i_jxbr2)=.true.
if (idiag_poynzmz/=0 .or. idiag_jxbm/=0 .or. idiag_jxbrms/=0) lpenc_diagnos(i_jxb)=.true.
if (idiag_jxbr2m/=0) lpenc_diagnos(i_jxbr2)=.true.
if (idiag_jxbrxmx/=0 .or. idiag_jxbrymx/=0 .or. idiag_jxbrzmx/=0 .or. &
idiag_jxbrxmy/=0 .or. idiag_jxbrymy/=0 .or. idiag_jxbrzmy/=0 .or. &
idiag_jxbrxmz/=0 .or. idiag_jxbrymz/=0 .or. idiag_jxbrzmz/=0) &
lpenc_diagnos(i_jxbr)=.true.
!
if (idiag_b2ruzm/=0) &
lpenc_diagnos(i_rho)=.true.
!
if (idiag_hjbm/=0) lpenc_diagnos(i_hjb)=.true.
!
if ( idiag_brmphi/=0 .or. idiag_uxbrmphi/=0 .or. idiag_jxbrmphi/=0 &
.or. idiag_armphi/=0 .or. idiag_brmr/=0 .or. idiag_armr/=0 &
.or. idiag_brbpmphi/=0 .or. idiag_brbzmphi/=0 .or. idiag_br2mphi/=0) then
lpenc_diagnos(i_pomx)=.true.
lpenc_diagnos(i_pomy)=.true.
endif
!
if ( idiag_bpmphi/=0 .or. idiag_uxbpmphi/=0 .or. idiag_jxbpmphi/=0 &
.or. idiag_bpmr/=0 .or. idiag_brbpmr/=0 .or. idiag_apmphi/=0 &
.or. idiag_apmr/=0 .or. idiag_brbpmphi/=0 .or. idiag_bpbzmphi/=0 &
.or. idiag_bp2mphi/=0) then
lpenc_diagnos(i_phix)=.true.
lpenc_diagnos(i_phiy)=.true.
endif
!
if (idiag_armr/=0 .or. idiag_apmr/=0 .or. idiag_azmr/=0) &
lpenc_diagnos(i_aa)=.true.
!
if (idiag_armphi/=0 .or. idiag_apmphi/=0 .or. idiag_azmphi/=0 .or. &
idiag_axmxz/=0 .or. idiag_aymxz/=0 .or. idiag_azmxz/=0 .or. &
idiag_axmxy/=0 .or. idiag_aymxy/=0 .or. idiag_azmxy/=0) &
lpenc_diagnos2d(i_aa)=.true.
!
if (idiag_vAmxz/=0) lpenc_diagnos2d(i_va2)=.true.
!
if (idiag_aybym2/=0 .or. idiag_exaym2/=0 .or. &
idiag_examx/=0 .or. idiag_examy/=0 .or. idiag_examz/=0 .or. &
idiag_exatotalmx/=0 .or. idiag_exatotalmy/=0 .or. idiag_exatotalmz/=0 .or. &
idiag_examz1/=0 .or. idiag_examz2/=0 .or. idiag_examz3/=0 .or. &
idiag_exatotalmz1/=0 .or. idiag_exatotalmz2/=0 .or. idiag_exatotalmz3/=0 .or. &
idiag_e3xamz1/=0 .or. idiag_e3xamz2/=0 .or. idiag_e3xamz3/=0 &
) lpenc_diagnos(i_aa)=.true.
!
if (idiag_examxy1/=0 .or. idiag_examxy2/=0 .or. idiag_examxy3/=0 &
) lpenc_diagnos2d(i_aa)=.true.
!
if (idiag_poynxmxy/=0 .or. idiag_poynymxy/=0 .or. idiag_poynzmxy/=0 &
) lpenc_diagnos2d(i_jxb)=.true.
if (idiag_poynxmxy/=0 .or. idiag_poynymxy/=0 .or. idiag_poynzmxy/=0 .or. &
idiag_Exmxy/=0 .or. idiag_Eymxy/=0 .or. idiag_Ezmxy/=0 &
) lpenc_diagnos2d(i_uxb)=.true.
!
if (idiag_StokesImxy/=0) lpenc_diagnos2d(i_StokesI)=.true.
if (idiag_StokesQmxy/=0) lpenc_diagnos2d(i_StokesQ)=.true.
if (idiag_StokesUmxy/=0) lpenc_diagnos2d(i_StokesU)=.true.
if (idiag_StokesQ1mxy/=0) lpenc_diagnos2d(i_StokesQ1)=.true.
if (idiag_StokesU1mxy/=0) lpenc_diagnos2d(i_StokesU1)=.true.
if (idiag_beta1mxy/=0) lpenc_diagnos2d(i_beta1)=.true.
!
if (idiag_a2m/=0 .or. idiag_arms/=0 .or. idiag_amax/=0 &
.or. idiag_a2b2m/=0 &
) lpenc_diagnos(i_a2)=.true.
if (idiag_divarms /= 0) lpenc_diagnos(i_diva) = .true.
if (idiag_ab_int/=0 .or. idiag_abm/=0 .or. idiag_abmh/=0 &
.or. idiag_abmz/=0 .or. idiag_abrms/=0 &
.or. idiag_abumx/=0 .or. idiag_abumy/=0 .or. idiag_abumz/=0 &
.or. idiag_abuxmz/=0 .or. idiag_abuymz/=0 .or. idiag_abuzmz/=0 &
) lpenc_diagnos(i_ab)=.true.
if (idiag_abmxy/=0) lpenc_diagnos2d(i_ab)=.true.
if (idiag_ubmxy/=0) lpenc_diagnos2d(i_ub)=.true.
!
if (idiag_uam/=0 .or. idiag_uamz/=0 .or. idiag_bzuamz/=0) lpenc_diagnos(i_ua)=.true.
if (idiag_djuidjbim/=0 &
.or. idiag_dexbmx/=0 .or. idiag_dexbmy/=0 .or. idiag_dexbmz/=0 &
.or. idiag_b3b12m/=0 .or. idiag_b3b21m/=0 &
.or. idiag_b1b32m/=0 .or. idiag_b1b23m/=0 &
.or. idiag_b2b13m/=0 .or. idiag_b2b31m/=0 ) &
lpenc_diagnos(i_bij)=.true.
!
if (lcovariant_magnetic.and.idiag_bij_cov_diffmax/=0) then
lpenc_diagnos(i_bij)=.true.
lpenc_diagnos(i_bijtilde)=.true.
lpenc_diagnos(i_bij_cov_corr)=.true.
endif
!
if (idiag_divamz/=0 .or. idiag_bzdivamz/=0) lpenc_diagnos(i_diva)=.true.
if (idiag_bzdivamz/=0 .or. idiag_bzLammz/=0) lpenc_diagnos(i_bb)=.true.
if (idiag_bzLammz/=0) lpenc_diagnos(i_Lam)=.true.
!
if (idiag_j2m/=0 .or. idiag_jm2/=0 .or. idiag_jrms/=0 .or. &
idiag_jmax/=0 .or. idiag_epsM/=0 .or. idiag_epsM_LES/=0 .or. &
idiag_epsM2/=0 .or.idiag_epsM3/=0 .or. idiag_epsM4/=0 .or. &
idiag_ajm/=0 .or. idiag_j2mz/=0 .or. idiag_epsMmz/=0 .or. &
idiag_j2b2m/=0) &
lpenc_diagnos(i_j2)=.true.
!
if (idiag_hjrms/=0 ) lpenc_diagnos(i_hj2)= .true.
if (idiag_epsAD/=0 .and. &
.not. (lambipolar_strong_coupling.and.tauAD/=0.0)) &
lpenc_diagnos(i_jxbr2)=.true.
if (idiag_jb_int/=0 .or. idiag_jbm/=0.or. idiag_jbmn/=0 .or. idiag_jbms/=0 &
.or. idiag_jbmz/=0 .or. idiag_jbrms/=0 &
) lpenc_diagnos(i_jb)=.true.
if (idiag_d6abmz/=0) lpenc_diagnos(i_d6ab)=.true.
if (idiag_d6amz1/=0 .or. idiag_d6amz2 /=0 .or. idiag_d6amz3/=0) lpenc_diagnos(i_del6a)=.true.
if (idiag_hjbm/=0 ) lpenc_diagnos(i_hjb)=.true.
if (idiag_jbmphi/=0 .or. idiag_jbmxy/=0) lpenc_diagnos2d(i_jb)=.true.
if (idiag_vArms/=0 .or. idiag_vA23rms/=0 .or. idiag_vAmax/=0 .or. idiag_vA2m/=0) lpenc_diagnos(i_va2)=.true.
if (idiag_vA23rms/=0) lpenc_diagnos(i_rho1)=.true.
if (idiag_cosubm/=0) lpenc_diagnos(i_cosub)=.true.
if (idiag_ubm/=0 .or. idiag_ubmz/=0 &
.or. idiag_ubbzm/=0) lpenc_diagnos(i_ub)=.true.
if (idiag_ujm/=0 .or. idiag_ujmz/=0) lpenc_diagnos(i_uj)=.true.
if (idiag_obm/=0 .or. idiag_obmz/=0) lpenc_diagnos(i_ob)=.true.
!
if (idiag_djuidjbim/=0 .or. idiag_uxDxuxbm/=0) lpenc_diagnos(i_uij)=.true.
if (idiag_uxjm/=0) lpenc_diagnos(i_uxj)=.true.
if (idiag_uxbm/=0 .or. idiag_uxbmx/=0 .or. idiag_uxbmy/=0 .or. idiag_uxbmz/=0 &
.or. idiag_uxbcmx/=0 .or. idiag_uxbcmy/=0 &
.or. idiag_uxbsmx/=0 .or. idiag_uxbsmy/=0 &
.or. idiag_Expt/=0 .or. idiag_Eypt/=0 .or. idiag_Ezpt/=0) lpenc_diagnos(i_uxbb)=.true.
if (idiag_uxBrms/=0 .or. idiag_Rmrms/=0 .or. idiag_Rmmz/=0) &
lpenc_diagnos(i_uxb2)=.true.
if (idiag_beta1m/=0 .or. idiag_beta1max/=0 .or. idiag_beta1mz/=0) &
lpenc_diagnos(i_beta1)=.true.
if (idiag_betam /= 0 .or. idiag_betamax /= 0 .or. idiag_betamin /= 0 .or. &
idiag_betamz /= 0 .or. idiag_beta2mz /= 0 .or. &
idiag_betamx /= 0 .or. idiag_beta2mx /= 0) lpenc_diagnos(i_beta) = .true.
if (idiag_bxmz/=0 .or. idiag_bymz/=0) lpenc_diagnos(i_bb)=.true.
if (idiag_djuidjbim/=0) lpenc_diagnos(i_djuidjbi)=.true.
if (idiag_b2divum/=0) lpenc_diagnos(i_divu)=.true.
if (idiag_b2divum/=0) lpenc_diagnos(i_b2)=.true.
if (idiag_ujxbmz/=0.or.idiag_ujxbm/=0) lpenc_diagnos(i_ujxb)=.true.
if (idiag_WL2D/=0) then
lpenc_diagnos(i_jj)=.true.
lpenc_diagnos(i_uga)=.true.
endif
if (idiag_WL3D/=0) then
lpenc_diagnos(i_jj)=.true.
lpenc_diagnos(i_uu)=.true.
lpenc_diagnos(i_aij)=.true.
endif
if (idiag_WL3D2/=0) then
lpenc_diagnos(i_jj)=.true.
lpenc_diagnos(i_aa)=.true.
lpenc_diagnos(i_uij)=.true.
endif
if (idiag_bij2m/=0) then
lpenc_diagnos(i_bb)=.true.
lpenc_diagnos(i_b2)=.true.
lpenc_diagnos(i_bij)=.true.
lpenc_diagnos(i_gb22)=.true.
endif
if (idiag_sijbibjm/=0) then
lpenc_diagnos(i_bb)=.true.
lpenc_diagnos(i_sij)=.true.
endif
if (idiag_ubgbpm/=0) lpenc_diagnos(i_ubgbp)=.true.
if (idiag_ugb22m/=0) lpenc_diagnos(i_ugb22)=.true.
if (idiag_gpxbm/=0) lpenc_diagnos(i_glnrhoxb)=.true.
if (idiag_jxbxbm/=0) lpenc_diagnos(i_jxbxb)=.true.
if (idiag_oxuxbm/=0) lpenc_diagnos(i_oxuxb)=.true.
if (idiag_exaym2/=0 .or. idiag_exjm2/=0 &
.or. idiag_jxmz/=0 .or. idiag_jymz/=0 &
.or. idiag_jxph1mz/=0 .or. idiag_jyph1mz/=0 .or. idiag_jzph1mz/=0 &
.or. idiag_jxph2mz/=0 .or. idiag_jyph2mz/=0 .or. idiag_jzph2mz/=0 &
.or. idiag_jxph3mz/=0 .or. idiag_jyph3mz/=0 .or. idiag_jzph3mz/=0 &
.or. idiag_jxpt/=0 .or. idiag_jypt/=0 .or. idiag_jzpt/=0 &
.or. idiag_jxp2/=0 .or. idiag_jyp2/=0 .or. idiag_jzp2/=0 &
.or. idiag_jmx/=0 .or. idiag_jmy/=0 .or. idiag_jmz/=0 &
.or. idiag_ambmz/=0 .or. idiag_jmbmz/=0 .or. idiag_kmz/=0 &
.or. idiag_examx/=0 .or. idiag_examy/=0 .or. idiag_examz/=0 &
.or. idiag_examz1/=0 .or. idiag_examz2/=0 .or. idiag_examz3/=0 &
.or. idiag_exjmx/=0 .or. idiag_exjmy/=0 .or. idiag_exjmz/=0 &
) lpenc_diagnos(i_jj)=.true.
!
if (idiag_examxy1/=0 .or. idiag_examxy2/=0 .or. idiag_examxy3/=0 &
) lpenc_diagnos2d(i_jj)=.true.
!
if (idiag_examz1/=0 .or. idiag_examz2/=0 .or. idiag_examz3/=0 .or. &
idiag_exatop/=0 .or. idiag_exabot/=0 &
) lpenc_diagnos(i_exa)=.true.
if (idiag_e3xamz1/=0 .or. idiag_e3xamz2/=0 .or. idiag_e3xamz3/=0 &
) lpenc_diagnos(i_e3xa)=.true.
!
if (idiag_examxy1/=0 .or. idiag_examxy2/=0 .or. idiag_examxy3/=0 &
) lpenc_diagnos2d(i_exa)=.true.
!
if (idiag_phibmx/=0 .or. idiag_phibmy/=0 .or. idiag_phibmz/=0 &
) lpenc_diagnos(i_diva)=.true.
if (idiag_a2mz/=0) lpenc_diagnos(i_a2)=.true.
if (idiag_b2uzm/=0 .or. idiag_b2ruzm/=0 .or. &
idiag_b1m/=0 .or. idiag_b2m/=0 .or. idiag_b4m/=0 .or. idiag_b6m/=0 .or. &
idiag_b12m/=0 .or. idiag_bm2/=0 .or. idiag_EEM/=0 .or. &
idiag_EEM2/=0 .or. idiag_EEM3/=0 .or. idiag_EEM4/=0 .or. &
idiag_brmsh/=0 .or. idiag_brmsn/=0 .or. idiag_brmss/=0 .or. &
idiag_brmsx/=0 .or. idiag_brmsz/=0 .or. &
idiag_brms/=0 .or. idiag_bmax/=0 .or. idiag_b2sphm/=0 .or. &
idiag_emag/=0 .or. idiag_b2mx /= 0 .or. idiag_b2mz/=0 .or. &
idiag_a2b2m/=0 .or. idiag_j2b2m/=0) &
lpenc_diagnos(i_b2)=.true.
if (idiag_b2sphm/=0) lpenc_diagnos(i_r_mn)=.true.
if (idiag_bfrms/=0 .or.idiag_bf2m/=0 .or. idiag_bf4m/=0 .or. &
idiag_bf2mz/=0) lpenc_diagnos(i_bf2)=.true.
if (idiag_etavamax/=0) lpenc_diagnos(i_etava)=.true.
if (idiag_etajmax/=0) lpenc_diagnos(i_etaj)=.true.
if (idiag_etaj2max/=0) lpenc_diagnos(i_etaj2)=.true.
if (idiag_etajrhomax/=0) lpenc_diagnos(i_etajrho)=.true.
if (idiag_cosjbm/=0) lpenc_diagnos(i_cosjb)=.true.
if (idiag_coshjbm/=0) lpenc_diagnos(i_coshjb)=.true.
if (idiag_cosubm/=0) lpenc_diagnos(i_cosub)=.true.
if ((idiag_jparallelm/=0).or.(idiag_jperpm/=0)) then
lpenc_diagnos(i_jparallel)=.true.
lpenc_diagnos(i_jperp)=.true.
endif
if ((idiag_hjparallelm/=0).or.(idiag_hjperpm/=0)) then
lpenc_diagnos(i_hjparallel)=.true.
lpenc_diagnos(i_hjperp)=.true.
endif
if (idiag_b2mphi/=0 .or. idiag_b2mxz/=0) lpenc_diagnos2d(i_b2)=.true.
if (idiag_brsphmphi/=0) lpenc_diagnos2d(i_evr)=.true.
if (idiag_bthmphi/=0) lpenc_diagnos2d(i_evth)=.true.
if (idiag_dbxdxmxy/=0.or.idiag_dbxdymxy/=0.or.idiag_dbxdzmxy/=0 .or. &
idiag_dbydxmxy/=0.or.idiag_dbydymxy/=0.or.idiag_dbydzmxy/=0 .or. &
idiag_dbzdxmxy/=0.or.idiag_dbzdymxy/=0.or.idiag_dbzdzmxy/=0) &
lpenc_diagnos2d(i_bijtilde)=.true.
if (lisotropic_advection) lpenc_requested(i_va2)=.true.
if (idiag_abumx/=0 .or. idiag_abumy/=0 .or. idiag_abumz/=0 &
.or. idiag_abuxmz/=0 .or. idiag_abuymz/=0 .or. idiag_abuzmz/=0) &
lpenc_diagnos(i_uu)=.true.
if (idiag_bxph1mz/=0 .or. idiag_bxph2mz/=0 .or. idiag_bxph3mz/=0 .or. &
idiag_byph1mz/=0 .or. idiag_byph2mz/=0 .or. idiag_byph3mz/=0 .or. &
idiag_bzph1mz/=0 .or. idiag_bzph2mz/=0 .or. idiag_bzph3mz/=0 .or. &
idiag_bx2ph1mz/=0 .or. idiag_bx2ph2mz/=0 .or. idiag_bx2ph3mz/=0 .or. &
idiag_by2ph1mz/=0 .or. idiag_by2ph2mz/=0 .or. idiag_by2ph3mz/=0 .or. &
idiag_bz2ph1mz/=0 .or. idiag_bz2ph2mz/=0 .or. idiag_bz2ph3mz/=0 .or. &
idiag_bx2rph1mz/=0 .or. idiag_bx2rph2mz/=0 .or. idiag_bx2rph3mz/=0 .or. &
idiag_by2rph1mz/=0 .or. idiag_by2rph2mz/=0 .or. idiag_by2rph3mz/=0 .or. &
idiag_bz2rph1mz/=0 .or. idiag_bz2rph2mz/=0 .or. idiag_bz2rph3mz/=0 .or. &
idiag_jbph1mz/=0 .or. idiag_jbph2mz/=0 .or. idiag_jbph3mz/=0 .or. &
idiag_poynzph1mz/=0 .or. idiag_poynzph2mz/=0 .or. idiag_poynzph3mz/=0 .or. &
idiag_jxph1mz/=0 .or. idiag_jyph1mz/=0 .or. idiag_jzph1mz/=0 .or. &
idiag_jxph2mz/=0 .or. idiag_jyph2mz/=0 .or. idiag_jzph2mz/=0 .or. &
idiag_jxph3mz/=0 .or. idiag_jyph3mz/=0 .or. idiag_jzph3mz/=0 .or. &
idiag_abph1mz/=0 .or. idiag_abph2mz/=0 .or. idiag_abph3mz/=0) lpenc_diagnos(i_ss)=.true.
!
! Check whether right variables are set for half-box calculations.
!
if (idiag_brmsn/=0 .or. idiag_abmn/=0 .or. idiag_ambmzn/=0 .or. idiag_jbmn/= 0 ) then
if ((.not.lequatory).and.(.not.lequatorz)) then
call fatal_error('pencil_criteria_magnetic', &
"You have to set either of lequator[y|z] to true to calculate averages over half the box")
else
if (lequatory) write(*,*) 'pencil-criteria_magnetic: box divided along y dirn'
if (lequatorz) write(*,*) 'pencil-criteria_magnetic: box divided along z dirn'
endif
endif
!
! check for pencil_criteria_magn_mf
!
if (lmagn_mf) call pencil_criteria_magn_mf
!
endsubroutine pencil_criteria_magnetic
!***********************************************************************
subroutine pencil_interdep_magnetic(lpencil_in)
!
! Interdependency among pencils from the Magnetic module is specified here.
!
! 19-nov-04/anders: coded
!
logical, dimension(npencils) :: lpencil_in
!
if (.not.lcartesian_coords.and.(lpencil_in(i_bij).or.lpencil_in(i_del2a))) &
lpencil_in(i_aij)=.true.
if (lpencil_in(i_hjparallel).or.lpencil_in(i_hjperp)) then
lpencil_in(i_coshjb)=.true.
lpencil_in(i_hj2)=.true.
lpencil_in(i_b2)=.true.
endif
!
if (lpencil_in(i_jparallel).or.lpencil_in(i_jperp)) then
lpencil_in(i_cosjb)=.true.
lpencil_in(i_jxb)=.true.
lpencil_in(i_j2)=.true.
lpencil_in(i_b2)=.true.
endif
!
if (lpencil_in(i_cosjb)) then
lpencil_in(i_b2)=.true.
lpencil_in(i_j2)=.true.
lpencil_in(i_jb)=.true.
endif
if (lpencil_in(i_coshjb)) then
lpencil_in(i_b2)=.true.
lpencil_in(i_hj2)=.true.
lpencil_in(i_hjb)=.true.
endif
!
if (lpencil_in(i_hjb)) then
lpencil_in(i_bb)=.true.
lpencil_in(i_hjj)=.true.
endif
!
if (lpencil_in(i_hj2)) lpencil_in(i_hjj)=.true.
!
if (lpencil_in(i_hjj)) lpencil_in(i_del4a)=.true.
!
if (lpencil_in(i_a2)) lpencil_in(i_aa)=.true.
!
if (lpencil_in(i_ab)) then
lpencil_in(i_aa)=.true.
lpencil_in(i_bb)=.true.
endif
!
if (lpencil_in(i_ua)) then
lpencil_in(i_uu)=.true.
lpencil_in(i_aa)=.true.
endif
!
if (lpencil_in(i_etava)) lpencil_in(i_va2)=.true.
if (lpencil_in(i_jxbr) .and. va2max_jxb>0) lpencil_in(i_va2)=.true.
!
if (lpencil_in(i_jxbr) .and. betamin_jxb>0) then
lpencil_in(i_va2)=.true.
lpencil_in(i_cs2)=.true.
endif
!
if (lpencil_in(i_va2)) then
lpencil_in(i_b2)=.true.
lpencil_in(i_rho1)=.true.
endif
!
if (lpencil_in(i_etaj) .or. lpencil_in(i_etaj2) .or. lpencil_in(i_etajrho)) then
lpencil_in(i_j2)=.true.
lpencil_in(i_rho1)=.true.
endif
!
if (lpencil_in(i_j2)) lpencil_in(i_jj)=.true.
!
! if (lpencil_in(i_curlb)) lpencil_in(i_jj)=.true.
!AB: now the other way around
if (lpencil_in(i_jj)) lpencil_in(i_curlb)=.true.
!
if (lpencil_in(i_uxj)) then
lpencil_in(i_uu)=.true.
lpencil_in(i_jj)=.true.
endif
!
if (lpencil_in(i_jb)) then
lpencil_in(i_bb)=.true.
lpencil_in(i_jj)=.true.
endif
!
if (lpencil_in(i_hjb)) then
lpencil_in(i_bb)=.true.
lpencil_in(i_hjj)=.true.
endif
!
if (lpencil_in(i_jxbr2)) lpencil_in(i_jxbr)=.true.
!
if (lpencil_in(i_jxbr)) then
lpencil_in(i_jxb)=.true.
lpencil_in(i_rho1)=.true.
endif
!
if (lpencil_in(i_jxb)) then
lpencil_in(i_jj)=.true.
lpencil_in(i_bb)=.true.
endif
!
if (lpencil_in(i_uxb2)) lpencil_in(i_uxb)=.true.
!
if (lpencil_in(i_uxb)) then
lpencil_in(i_uu)=.true.
lpencil_in(i_bb)=.true.
endif
!
if (lpencil_in(i_cosub)) then
lpencil_in(i_ub)=.true.
lpencil_in(i_u2)=.true.
lpencil_in(i_b2)=.true.
endif
!
if (lpencil_in(i_ub)) then
lpencil_in(i_uu)=.true.
lpencil_in(i_bb)=.true.
endif
!
if (lpencil_in(i_ob)) then
lpencil_in(i_oo)=.true.
lpencil_in(i_bb)=.true.
endif
!
if (lpencil_in(i_uj)) then
lpencil_in(i_uu)=.true.
lpencil_in(i_jj)=.true.
endif
!
if (lpencil_in(i_chibp)) lpencil_in(i_bb)=.true.
if (lpencil_in(i_StokesI)) lpencil_in(i_bb)=.true.
!
if (lpencil_in(i_StokesQ).or.lpencil_in(i_StokesU).or.&
lpencil_in(i_StokesQ1).or.lpencil_in(i_StokesU1)) then
lpencil_in(i_b2)=.true.
lpencil_in(i_chibp)=.true.
lpencil_in(i_StokesI)=.true.
endif
!
if (lpencil_in(i_beta1) .or. lpencil_in(i_beta)) then
lpencil_in(i_b2)=.true.
lpencil_in(i_pp)=.true.
endif
!
if (lpencil_in(i_bunit)) then
lpencil_in(i_bb)=.true.
lpencil_in(i_b2)=.true.
endif
!
if (lpencil_in(i_b2)) lpencil_in(i_bb)=.true.
if ((lpencil_in(i_curlb)) .and. .not. (ljj_as_comaux)) then
lpencil_in(i_del2a)=.true.
lpencil_in(i_bij)=.true.
endif
!
if (lpencil_in(i_djuidjbi)) then
lpencil_in(i_uij)=.true.
lpencil_in(i_bij)=.true.
endif
!
if (lpencil_in(i_jo)) then
lpencil_in(i_oo)=.true.
lpencil_in(i_jj)=.true.
endif
!
if (lpencil_in(i_b21)) lpencil_in(i_b2)=.true.
!
if (lpencil_in(i_ujxb)) then
lpencil_in(i_uu)=.true.
lpencil_in(i_jxb)=.true.
endif
!
if (lpencil_in(i_ugb22)) then
lpencil_in(i_uu)=.true.
lpencil_in(i_gb22)=.true.
endif
!
if (lpencil_in(i_ubgbp)) then
lpencil_in(i_uu)=.true.
lpencil_in(i_bgbp)=.true.
endif
!
if (lpencil_in(i_bgbp)) then
lpencil_in(i_bb)=.true.
lpencil_in(i_b21)=.true.
lpencil_in(i_bij)=.true.
lpencil_in(i_bgb)=.true.
endif
!
!AB if (lpencil_in(i_oxu)) then
! lpencil_in(i_oo)=.true.
! lpencil_in(i_uu)=.true.
! endif
!
if (lpencil_in(i_oxuxb)) then
lpencil_in(i_oxu)=.true.
lpencil_in(i_bb)=.true.
endif
!
if (lpencil_in(i_jxbxb)) then
lpencil_in(i_jxb)=.true.
lpencil_in(i_bb)=.true.
endif
!
if (lpencil_in(i_jxbrxb)) then
lpencil_in(i_jxbr)=.true.
lpencil_in(i_bb)=.true.
endif
!
if (lpencil_in(i_glnrhoxb)) then
lpencil_in(i_glnrho)=.true.
lpencil_in(i_bb)=.true.
endif
!
if (lpencil_in(i_oxj)) then
lpencil_in(i_oo)=.true.
lpencil_in(i_jj)=.true.
endif
!
if (lpencil_in(i_jij)) lpencil_in(i_bij)=.true.
!
if (lpencil_in(i_sj)) then
lpencil_in(i_sij)=.true.
lpencil_in(i_jij)=.true.
endif
if (lpencil_in(i_ss12)) lpencil_in(i_sij)=.true.
if (lpencil_in(i_del2a)) then
if (lspherical_coords) then
!WL: for the cylindrical case, lpencil_check says these pencils are not needed
!AB: don't understand; this comment is in lspherical_coords.
!AB: I suggest you just fix it when you get to this point again.
lpencil_in(i_jj)=.true.
lpencil_in(i_graddivA)=.true.
endif
endif
if (lpencil_in(i_uga)) then
lpencil_in(i_aij)=.true.
lpencil_in(i_uu)=.true.
endif
!
if (lpencil_in(i_uuadvec_gaa)) then
lpencil_in(i_uu_advec)=.true.
lpencil_in(i_aij)=.true.
lpencil_in(i_uu)=.true.
lpencil_in(i_aa)=.true.
endif
!
if (lpencil_in(i_d6ab) .or. lpencil_in(i_e3xa)) lpencil_in(i_del6a)=.true.
!
if (lpencil_in(i_ss12)) lpencil_in(i_sj)=.true.
!
if (lpencil_in(i_gva)) lpencil_in(i_va2)=.true.
!
! Interdependencies for Boris Correction
!
if (lpencil_in(i_gamma_A2)) then
lpencil_in(i_va2)=.true.
lpencil_in(i_clight2)=.true.
endif
!
! For magnetic friction
!
if (lpencil_in(i_vmagfric)) then
lpencil_in(i_b2)=.true.
lpencil_in(i_jxb)=.true.
endif
!
! The dependence of diva or bb on aa relies on if aij is requested above.
!
if ((lpencil_in(i_diva) .or. (lpencil_in(i_bb) .and. .not. lbb_as_comaux)) .and. &
(.not. lcartesian_coords .and. lpencil_in(i_aij))) &
lpencil_in(i_aa) = .true.
!
! check for pencil_interdep_magn_mf
!
if (lmagn_mf) call pencil_interdep_magn_mf(lpencil_in)
!
endsubroutine pencil_interdep_magnetic
!***********************************************************************
subroutine magnetic_before_boundary(f)
!
! Conduct pre-processing required before boundary conditions and pencil
! calculations.
! In particular, calculate means for removal and test-field methods.
!
! 30-may-14/ccyang: coded
! 20-oct-21/MR: moved average removal from magnetic_after_boundary
!
use Boundcond, only: update_ghosts, zero_ghosts
use Sub, only: gij, gij_etc, curl_mn, dot2_mn, finalize_aver
use EquationOfState, only: rho0
use Yinyang_mpi, only: zsum_yy
use Mpicomm, only: mpiallreduce_sum
use Poisson
real, dimension(mx,my,mz,mfarray), intent(inout) :: f
real :: fact
integer :: l,j,ml,nl
real, dimension(:,:,:), allocatable :: buffer
real, dimension(:,:,:), allocatable :: rhs_poisson
real, dimension(nx,3) :: aamx,bb,jj
real, dimension(ny,3) :: aamy
real, dimension(nx,3,3) :: aij, bij
real, dimension(nx) :: rho1, b2, tmp, tmp2
real, dimension(3) :: B_ext
!
! Compute mean field (xy verage) for each component. Do not include the ghost zones.
!
if (lrmv) then
if (lremove_meanax) then
fact=1./nyzgrid
do j=1,3
do l=l1,l2
aamx(l-nghost,j)=fact*sum(f(l,m1:m2,n1:n2,iax+j-1))
enddo
enddo
call finalize_aver(nprocyz,23,aamx)
!
do j=1,3
do l=l1,l2
f(l,m1:m2,n1:n2,iax+j-1) = f(l,m1:m2,n1:n2,iax+j-1)-aamx(l-nghost,j)
enddo
enddo
endif
!
if (lremove_meanay) then
fact=1./nxzgrid
do j=1,3
do ml=m1,m2
aamy(ml-nghost,j)=fact*sum(f(l1:l2,ml,n1:n2,iax+j-1))
enddo
enddo
call finalize_aver(nprocxz,13,aamy)
!
do j=1,3
do ml=m1,m2
f(l1:l2,ml,n1:n2,iax+j-1) = f(l1:l2,ml,n1:n2,iax+j-1)-aamy(ml-nghost,j)
enddo
enddo
endif
endif
!
if (lcalc_aameanz .or. lrmv.and.lremove_meanaz) then
!
fact=1./nxygrid
do j=1,3
do nl=n1,n2
aamz(nl,j)=fact*sum(f(l1:l2,m1:m2,nl,iax+j-1))
enddo
enddo
call finalize_aver(nprocxy,12,aamz)
!
if (lrmv.and.lremove_meanaz) then
do j=1,3
do nl=n1,n2
f(l1:l2,m1:m2,nl,iax+j-1) = f(l1:l2,m1:m2,nl,iax+j-1)-aamz(nl,j)
enddo
enddo
endif
endif
!
! Calculate Arms for quenching. MR: should be Brms or not?
!
if (lquench_eta_aniso) then
Arms=sum(f(l1:l2,m1:m2,n1:n2,iaa:iaa+2)**2) ! requires equidistant grid
call mpiallreduce_sum(Arms,fact)
Arms=sqrt(fact/nwgrid)
endif
!
! Remove mean field (y average).
!
if (lrmv) then
if (lremove_meanaxz) then
!
fact=1./nygrid
do j=1,3
aamxz=fact*sum(f(l1:l2,m1:m2,n1:n2,iaa+j-1),2) ! requires equidistant grid
call finalize_aver(nprocy,2,aamxz)
!
do ml=m1,m2
f(l1:l2,ml,n1:n2,iaa+j-1) = f(l1:l2,ml,n1:n2,iaa+j-1)-aamxz
enddo
enddo
endif
!
! Remove mean field (z average).
!
if (lremove_meanaxy) then
!
fact=1./nzgrid_eff
if (lyang.and..not.allocated(buffer)) allocate(buffer(1,mx,ny))
do j=1,3
if (lyang) then
!
! On Yang grid:
!
do nl=n1,n2
do ml=m1,m2
call zsum_yy(buffer,1,ml,nl,f(:,ml,nl,iaa+j-1))
enddo
enddo
aamxy=fact*buffer(1,:,:)
else
!
! Normal summing-up in Yin procs.
!
aamxy=fact*sum(f(l1:l2,m1:m2,n1:n2,iaa+j-1),3) ! requires equidistant grid
endif
call finalize_aver(nprocz,3,aamxy)
!
do nl=n1,n2
f(l1:l2,m1:m2,nl,iaa+j-1) = f(l1:l2,m1:m2,nl,iaa+j-1)-tau_remove_meanaxy*aamxy
enddo
enddo
endif
endif
!
! Find bb and jj if as communicated auxiliary.
!
getbb: if (lbb_as_comaux .or. ljj_as_comaux .or. &
lalfven_as_aux.or. (lslope_limit_diff .and. llast)) then
call zero_ghosts(f, iax, iaz) !MR: needed given the next statement?
call update_ghosts(f, iax, iaz) !MR: only the "real" BCs matter here
do imn = 1, nyz
m = mm(imn)
n = nn(imn)
call gij(f, iaa, aij, 1)
call curl_mn(aij, bb, A=f(:,m,n,iax:iaz))
!
! calculate jj if requested
! (but this is not needed when displacement current is invoked)
!
if (ljj_as_comaux) then
if (irhoe/=0.and.ibb/=0) then
! p%jj_ohm=(p%el+p%uxb)*mu01/eta_total(1)
!AB: rhoe is apparently not ready yet
else
if (lcartesian_coords) then
call gij_etc(f,iaa,BIJ=bij)
call curl_mn(bij,jj)
else
call gij_etc(f,iaa,AA=f(:,m,n,iax:iaz),AIJ=aij,BIJ=bij, &
LCOVARIANT_DERIVATIVE=lcovariant_magnetic)
call curl_mn(bij,jj, A=bb,LCOVARIANT_DERIVATIVE=lcovariant_magnetic)
endif
endif
f(l1:l2,m,n,ijx:ijz) = jj
endif
!
! Add imposed field, if any
!
if (lbb_as_comaux) then
if (lB_ext_in_comaux) then
call get_bext(B_ext)
do j = 1,3; bb(:,j) = bb(:,j) + B_ext(j); enddo;
if (headtt .and. imn == 1) print *, 'magnetic_before_boundary: B_ext = ', B_ext
endif
f(l1:l2,m,n,ibx:ibz) = bb
!
! compute here divJ
!
!if (irhoe/=0.and.ibb/=0) then
endif
!
! Find Alfven speed as communicated auxiliary
!
if (lalfven_as_aux .or. (lslope_limit_diff .and. llast)) then
if (ldensity) then
if (ldensity_nolog) then
rho1=1./f(l1:l2,m,n,irho)
else
rho1=1./exp(f(l1:l2,m,n,ilnrho))
endif
else
rho1=1./rho0
endif
call dot2_mn(bb,b2)
tmp= b2*mu01*rho1
if (lcheck_positive_va2 .and. minval(tmp)<0.0) then
print*, 'magnetic_before_boundary: Alfven speed is imaginary!'
print*, 'magnetic_before_boundary: it, itsub, iproc=', it, itsub, iproc_world
print*, 'magnetic_before_boundary: m, y(m), n, z(n)=', m, y(m), n, z(n)
tmp=abs(tmp)
endif
if (lalfven_as_aux) f(l1:l2,m,n,ialfven)= tmp
if (lslope_limit_diff .and. llast) then
if (lboris_correction .and. va2max_boris>0) then
tmp2=tmp*((1+(tmp/va2max_boris)**2.)**(-1.0/2.0))
f(l1:l2,m,n,isld_char)=f(l1:l2,m,n,isld_char)+w_sldchar_mag*sqrt(tmp2)
else
f(l1:l2,m,n,isld_char)=f(l1:l2,m,n,isld_char)+w_sldchar_mag*sqrt(tmp)
endif
endif
endif
enddo ! mn_loop
endif getbb
!
! Possibility of calculating the magnetic helicity correction for the Coulomb gauge.
! Here, no minus sign has been included, so A_Coulomb = A_Weyl - gLambda, and
! <A.B>_C = <A.B>_W - gLambm, <A.A>_C = <A.A>_W - gLamam.
!
if (lcoulomb.and.lfirst) then
if (.not.allocated(rhs_poisson)) allocate(rhs_poisson(nx,ny,nz))
rhs_poisson=f(l1:l2,m1:m2,n1:n2,idiva)
call inverse_laplacian(rhs_poisson)
f(l1:l2,m1:m2,n1:n2,iLam)=rhs_poisson
endif
!
! put u.a into auxiliary array
!
if (lua_as_aux) &
!29-Oct-21/MR: ghost zones not up-to-date, so here better than in magnetic_after_boundary,
! but not yet correct in terms of "real" boundary conditions.
! Comes at the price of f(:,:,:,iua) being communicated.
f(:,:,:,iua)=sum(f(:,:,:,iux:iuz)*f(:,:,:,iax:iaz),4)
!
endsubroutine magnetic_before_boundary
!***********************************************************************
subroutine update_char_vel_magnetic(f)
!
! Add the Alfven speed to the characteritic velocity
! for slope limited diffusion.
!
! 25-sep-15/MR+joern: coded
!
! use General, only: staggered_mean_scal
use General, only: staggered_max_scal
use Density, only: calc_pencils_density
real, dimension (mx,my,mz,mfarray), intent(inout) :: f
!
type(pencil_case) :: p
logical, dimension(npencils) :: lpenc_loc=.false.
real, dimension(nx) :: tmp
!
if (lslope_limit_diff) then
!
! Calculate Alfven speed and store temporarily in first slot of diffusive fluxes.
!
lpenc_loc((/i_va2,i_bb,i_b2,i_rho1/))=.true.
do n=n1,n2; do m=m1,m2
call calc_pencils_density(f,p,lpenc_loc)
call calc_pencils_magnetic(f,p,lpenc_loc)
if (lboris_correction .and. va2max_boris>0) then
tmp=(1+(p%va2/va2max_boris)**2.)**(-1.0/2.0)
f(l1:l2,m,n,iFF_diff) = sqrt(p%va2*tmp)
else
f(l1:l2,m,n,iFF_diff) = sqrt(p%va2)
endif
enddo; enddo
!
!call staggered_mean_scal(f,iFF_diff,iFF_char_c,w_sldchar_mag)
call staggered_max_scal(f,iFF_diff,iFF_char_c,w_sldchar_mag)
endif
!
endsubroutine update_char_vel_magnetic
!***********************************************************************
subroutine calc_pencils_magnetic_std(f,p)
!
! Standard version (_std): global variable lpencil contains information about needed pencils.
!
real, dimension (mx,my,mz,mfarray), intent(inout):: f
type (pencil_case), intent(out) :: p
!
call calc_pencils_magnetic_pencpar(f,p,lpencil)
!
endsubroutine calc_pencils_magnetic_std
!***********************************************************************
subroutine calc_pencils_magnetic_pencpar(f,p,lpenc_loc)
!
! Calculate Magnetic pencils.
! Most basic pencils should come first, as others may depend on them.
!
! Version with formal parameter lpencil_loc instead of global lpencil for cases
! in which not necessarily all generally needed pencil are to be calculated.
!
! 19-nov-04/anders: coded
! 18-jun-13/axel: b2 now includes B_ext by default (luse_Bext_in_b2=T is kept)
! 20-jun-16/fred: added derivative tensor option and streamlined gij_etc
!
use EquationOfState, only: rho0
use General, only: notanumber
use SharedVariables, only: get_shared_variable
use Sub
!
real, dimension (mx,my,mz,mfarray), intent(inout):: f
type (pencil_case), intent(out) :: p
logical, dimension(:), intent(in) :: lpenc_loc
!
real, dimension (nx,3) :: tmp ! currently unused: bb_ext_pot
real, dimension (nx) :: rho1_jxb, quench, StokesI_ncr, tmp1, bbgb, va2max_beta
real, dimension (nx) :: Eabs, Babs
real, dimension(3) :: B_ext, j_ext
real :: c,s
real :: Eaver, Baver !, b2m
integer :: i, j, ix
if (lfirstpoint) lproc_print=.true.
! aa
if (lpenc_loc(i_aa)) p%aa=f(l1:l2,m,n,iax:iaz)
! a2
if (lpenc_loc(i_a2)) call dot2_mn(p%aa,p%a2)
! aij
if (lpenc_loc(i_aij)) call gij(f,iaa,p%aij,1)
! diva
if (lpenc_loc(i_diva)) then
! ccyang: Note that the following two methods do not give exactly
! the same results.
if (lpenc_loc(i_aij) .and. .not. lpencil_check_at_work) then
call div_mn(p%aij,p%diva,p%aa)
else
call div_other(f(:,:,:,iax:iaz),p%diva)
endif
if (lcoulomb) then
f(l1:l2,m,n,idiva)=p%diva
if (lpenc_loc(i_gLam)) then
call grad(f,iLam,p%gLam)
endif
endif
endif
! aps
if (lpenc_loc(i_aps)) p%aps=f(l1:l2,m,n,iaz)*p%rcyl_mn
! bb
if (lpenc_loc(i_bb)) then
if (lbb_as_comaux) then
p%bb = f(l1:l2,m,n,ibx:ibz)
! ccyang: Note that the following two methods do not give exactly
! the same results.
elseif (lpenc_loc(i_aij) .and. .not. lpencil_check_at_work) then
call curl_mn(p%aij,p%bb,A=p%aa)
else
call curl_other(f(:,:,:,iax:iaz),p%bb)
endif
!
! Save field before adding imposed field (for diagnostics).
! ##ccyang: Note that p%bb already contains B_ext if lbb_as_comaux
! .and. lB_ext_in_comaux = .true., which needs to be fixed.
!
p%bbb = p%bb
!
! Add a uniform background field, optionally precessing.
!
if (.not. (lbb_as_comaux .and. lB_ext_in_comaux) .and. (.not. ladd_global_field)) then
call get_bext(B_ext,j_ext)
if (any(B_ext/=0.)) then
if (lhubble_magnetic) then
do j = 1,3; if(B_ext(j) /= 0.0) p%bb(:,j) = p%bb(:,j) + B_ext(j)/ascale**2; enddo;
else
do j = 1,3; p%bb(:,j) = p%bb(:,j) + B_ext(j); enddo;
endif
if (headtt) print *, 'calc_pencils_magnetic_pencpar: B_ext = ', B_ext
if (headtt) print *, 'calc_pencils_magnetic_pencpar: logic = ', &
(lbb_as_comaux .and. lB_ext_in_comaux .and. ladd_global_field)
endif
! The following does not happen if (lbb_as_comaux .and. lB_ext_in_comaux) !
!AB: the following comes too early and is later done anyway
do j = 1,3; p%jj(:,j) = p%jj(:,j) + j_ext(j); enddo;
endif
!
! Add a precessing dipole not in the Bext field
!
if (dipole_moment /= 0.) then
c=cos(inclaa*pi/180); s=sin(inclaa*pi/180)
p%bb(:,1) = p%bb(:,1) + dipole_moment*2*(c*costh(m) + s*sinth(m)*cos(z(n)-omega_Bz_ext*t))*p%r_mn1**3
p%bb(:,2) = p%bb(:,2) + dipole_moment* (c*sinth(m) - s*costh(m)*cos(z(n)-omega_Bz_ext*t))*p%r_mn1**3
p%bb(:,3) = p%bb(:,3) + dipole_moment* ( s* sin(z(n)-omega_Bz_ext*t))*p%r_mn1**3
endif
!
! Add the external potential field.
!
! if (lB_ext_pot) then
! call get_global(bb_ext_pot,m,n,'B_ext_pot')
! p%bb=p%bb+bb_ext_pot
! endif
!
! Add external B-field.
!
if (ladd_global_field) then
call get_bext(B_ext)
! Only need the second component to scale the global field and first and third to add a
! const oblique component at arbitrary deg inclination.
if (iglobal_bx_ext/=0) p%bb(:,1)=p%bb(:,1)+B_ext(2)*f(l1:l2,m,n,iglobal_bx_ext)+B_ext(1)
if (iglobal_by_ext/=0) p%bb(:,2)=p%bb(:,2)+B_ext(2)*f(l1:l2,m,n,iglobal_by_ext)
if (iglobal_bz_ext/=0) p%bb(:,3)=p%bb(:,3)+B_ext(2)*f(l1:l2,m,n,iglobal_bz_ext)+B_ext(3)
endif
endif
!
! Add Bz stratification.
!
if (B0_ext_z /= 0.0) then
p%bb(:,3) = p%bb(:,3) + get_B0_ext_z(n)
endif
!
! b2 now (since 18 June 2013) includes B_ext by default.
! This can be changed by setting lignore_Bext_in_b2=T
!
if (lignore_Bext_in_b2 .or. (.not.luse_Bext_in_b2) ) then
if (lpenc_loc(i_b2)) call dot2_mn(p%bbb,p%b2)
else
if (lpenc_loc(i_b2)) call dot2_mn(p%bb,p%b2)
endif
if (lpenc_loc(i_bf2)) call dot2_mn(p%bbb,p%bf2)
!
if (lpenc_loc(i_b21)) then
where (p%b2>tini)
p%b21=1./p%b2
elsewhere
p%b21=0.
endwhere
endif
!
! rho=(rho0/10+B^2) !!!MR: below it is /100!
!
if (lmagneto_friction.and.lpenc_loc(i_rho1)) then
p%rho=rho0*1.0e-2+p%b2
p%rho1=1./p%rho
endif
! bunit
if (lpenc_loc(i_bunit)) then
quench = 1.0/max(tini,sqrt(p%b2))
if (lignore_Bext_in_b2 .or. (.not.luse_Bext_in_b2) ) then
do j=1,3
p%bunit(:,j) = p%bbb(:,j)*quench
enddo
else
do j=1,3
p%bunit(:,j) = p%bb(:,j)*quench
enddo
endif
endif
! ab
if (lpenc_loc(i_ab)) call dot_mn(p%aa,p%bbb,p%ab)
if (lpenc_loc(i_ua)) call dot_mn(p%uu,p%aa,p%ua)
! uxb
if (lpenc_loc(i_uxb)) then
call cross_mn(p%uu,p%bb,p%uxb)
! add external e-field.
do j=1,3
if (iglobal_eext(j)/=0) p%uxb(:,j)=p%uxb(:,j)+f(l1:l2,m,n,iglobal_eext(j))
enddo
endif
! u x bbb
if (lpenc_loc(i_uxbb)) call cross(p%uu,p%bbb,p%uxbb)
! uga
if (lpenc_loc(i_uga)) call u_dot_grad(f,iaa,p%aij,p%uu,p%uga,UPWIND=lupw_aa)
!
! uga for fargo
!
if (lpenc_loc(i_uuadvec_gaa)) then
do j=1,3
! This is calling scalar h_dot_grad, that does not add
! the inertial terms. They will be added here.
tmp = p%aij(:,j,:)
call h_dot_grad(p%uu_advec,tmp,p%uuadvec_gaa(:,j))
enddo
if (lcylindrical_coords) then
p%uuadvec_gaa(:,1) = p%uuadvec_gaa(:,1) - rcyl_mn1*p%uu(:,2)*p%aa(:,2)
p%uuadvec_gaa(:,2) = p%uuadvec_gaa(:,2) + rcyl_mn1*p%uu(:,2)*p%aa(:,1)
elseif (lspherical_coords) then
call not_implemented('calc_pencils_magnetic_pencpar',"uuadvec_gaa for spherical coordinates")
endif
endif
!
! bij, del2a, graddiva
! For non-cartesian coordinates jj is always required for del2a=graddiva-jj
! fred: del2a now calculated directly if required and gradient tensor available
! reduced calls to exclude unnecessary calculation of unwanted variables
! if (lpenc_loc(i_bij) .or. lpenc_loc(i_del2a) .or. lpenc_loc(i_graddiva) .or. &
! lpenc_loc(i_jj) ) then
! if (lcartesian_coords) then
! call gij_etc(f,iaa,p%aa,p%aij,p%bij,p%del2a,p%graddiva)
! if (.not. lpenc_loc(i_bij)) p%bij=0.0 ! Avoid warnings from pencil
! if (.not. lpenc_loc(i_del2a)) p%del2a=0.0 ! consistency check...
! if (.not. lpenc_loc(i_graddiva)) p%graddiva=0.0
!! if (lpenc_loc(i_jj)) call curl_mn(p%bij,p%jj,p%bb)
!!DM curl in cartesian does not need p%bb, then it is better not
!! to give it.
! if (lpenc_loc(i_jj)) call curl_mn(p%bij,p%jj)
! else
! call gij_etc(f,iaa,AA=p%aa,AIJ=p%aij,BIJ=p%bij,&
! GRADDIV=p%graddiva,&
! LCOVARIANT_DERIVATIVE=lcovariant_magnetic)
! if (.not. lpenc_loc(i_bij)) p%bij=0.0 ! Avoid warnings from pencil
! call curl_mn(p%bij,p%jj,A=p%bb,LCOVARIANT_DERIVATIVE=lcovariant_magnetic) ! consistency check...
! if (lpenc_loc(i_del2a)) p%del2a=p%graddiva-p%jj
!! if (lpenc_loc(i_del2a)) call del2v(f,iaa,p%del2a,p%aij,p%aa)
! endif
! endif
!
! In the following, we assume that there is no displacement current,
! so curlb=jj, so we should replace p%jj by p%curlb.
! 2024-06-27/AB: done now
!
! AB: not sure why we have "and.lpenc_loc(i_del2a)"
!
if (lpenc_loc(i_bij).and.lpenc_loc(i_del2a)) then
if (lcartesian_coords) then
call gij_etc(f,iaa,BIJ=p%bij,DEL2=p%del2a)
if (lpenc_loc(i_curlb) .and. .not. ljj_as_comaux) call curl_mn(p%bij,p%curlb)
else
call gij_etc(f,iaa,AA=p%aa,AIJ=p%aij,BIJ=p%bij,DEL2=p%del2a, &
! GRADDIV=p%graddiva,&
LCOVARIANT_DERIVATIVE=lcovariant_magnetic)
if (lpenc_loc(i_curlb) .and. .not. ljj_as_comaux) &
!call curl_mn(p%bij,p%jj,A=p%bb,LCOVARIANT_DERIVATIVE=lcovariant_magnetic)
call curl_mn(p%bij,p%curlb,A=p%bb,LCOVARIANT_DERIVATIVE=lcovariant_magnetic)
endif
elseif (lpenc_loc(i_bij).and..not.lpenc_loc(i_del2a)) then
if (lcartesian_coords) then
call gij_etc(f,iaa,BIJ=p%bij)
!if (lpenc_loc(i_jj).and. .not. ljj_as_comaux) call curl_mn(p%bij,p%jj)
if (lpenc_loc(i_curlb).and. .not. ljj_as_comaux) call curl_mn(p%bij,p%curlb)
else
call gij_etc(f,iaa,AA=p%aa,AIJ=p%aij,BIJ=p%bij,LCOVARIANT_DERIVATIVE=lcovariant_magnetic)
!if (lpenc_loc(i_jj).and. .not. ljj_as_comaux) &
! call curl_mn(p%bij,p%jj,A=p%bb,LCOVARIANT_DERIVATIVE=lcovariant_magnetic)
if (lpenc_loc(i_curlb).and. .not. ljj_as_comaux) &
call curl_mn(p%bij,p%curlb,A=p%bb,LCOVARIANT_DERIVATIVE=lcovariant_magnetic)
endif
elseif (lpenc_loc(i_del2a).and..not.lpenc_loc(i_bij)) then
if (lcartesian_coords) then
call gij_etc(f,iaa,DEL2=p%del2a)
else
call gij_etc(f,iaa,AA=p%aa,AIJ=p%aij,DEL2=p%del2a,LCOVARIANT_DERIVATIVE=lcovariant_magnetic)
endif
endif
if (lpenc_loc(i_bijtilde)) then
if (lcovariant_magnetic) then
call bij_tilde(f,p%bb,p%bijtilde,p%bij_cov_corr)
else
call bij_tilde(f,p%bb,p%bijtilde)
endif
endif
!
! Possibility that jj is already calculated as comaux
!
if (ljj_as_comaux .and. lpenc_loc(i_jj)) then
!
! Apply a gaussian smoothing using 3 points before and after
! make sense to use with SLD on magnetic field or vector potential
! uses the kern_jjsmooth as kernels
!
if (lsmooth_jj) then
do j=1,3
call smooth_mn(f,ijx+(j-1),kern_jjsmooth,p%jj(:,j))
enddo
else
p%jj=f(l1:l2,m,n,ijx:ijz)
endif
endif
!
! possibility of diamagnetism
!
if (ldiamagnetism) call diamagnetism(p)
!
! jj
!
if (lpenc_loc(i_jj) .or. lpenc_loc(i_jj_ohm)) then
if (lvacuum) then
p%jj=0.
p%jj_ohm=0.
eta_total=huge1
eta_xtdep=huge1
eta_tdep=huge1
else
!
! The following allows us to let eta change with time, t-eta_tdep_toffset.
! The eta_tdep_toffset is used in cosmology where time starts at t=1.
! lresi_eta_tdep_t0_norm is not the default because of backward compatbility.
! The default is problematic because then eta_tdep /= eta for t < eta_tdep_t0.
!
if (lresi_eta_tdep .or. lresi_eta_xtdep .or. lresi_hyper2_tdep .or. lresi_hyper3_tdep) then
select case (tdep_eta_type)
case ('const')
eta_tdep=eta
case ('standard')
if (lresi_eta_tdep_t0_norm) then
eta_tdep=eta*max(real(t-eta_tdep_toffset)/eta_tdep_t0,1.)**eta_tdep_exponent
else
eta_tdep=eta*max(real(t-eta_tdep_toffset),eta_tdep_t0)**eta_tdep_exponent
endif
case ('standard2')
eta_tdep=eta*(1.+max(real(t-eta_tdep_toffset)/eta_tdep_t0,0.))**eta_tdep_exponent
case ('log-switch-on')
eta_tdep=eta*exp((alog(eta_max)-alog(eta)) &
*max(min((1.-real(t-eta_tdep_toffset)/eta_tdep_t0),1.),0.))
case ('linear-sigma')
eta_tdep=1./(1./eta_max+(1./eta-1./eta_max) &
*max(min(real(t-eta_tdep_toffset)/eta_tdep_t0,1.),0.))
case ('ascale_power')
eta_tdep=eta*ascale**eta_tdep_ascale_power
case ('eta_table')
call fatal_error('magnetic_after_boundary','eta_table not yet completed')
eta_tdep=0.
case ('mean-field')
!
! eta_tdep (luse_scale_factor_in_sigma=T by default)
!
!
! get other shared variables
!
call get_shared_variable('lrho_chi',lrho_chi, caller='initialize_magnetic')
!
! need e2m, b2m
!
if (.not. lrho_chi) call fatal_error('calc_pencils_magnetic_pencpar', &
'lrho_chi must be true when using mean-field')
!
! if (ncpus>1.or.dimensionality>1) call fatal_error('calc_pencils_magnetic_pencpar', &
! 'not programmed for multiple procs or more than 1 dimension')
! Eaver=sqrt(sum(f(l1:l2,m,n,iex)**2+f(l1:l2,m,n,iey)**2+f(l1:l2,m,n,iez)**2)/nx)
! Baver=sqrt(sum(p%b2)/nx+B_ext2)
!XXX
!call get_shared_variable('e2m_all', e2m_all, caller='initialize_magnetic')
call get_shared_variable('e2m_all', e2m_all)
call get_shared_variable('b2m_all', b2m_all)
Eaver=sqrt(e2m_all)
Baver=sqrt(b2m_all+B_ext2)
!
! Compute sigmaE. Note that eta_tdep=0 for Baver=0.
! By default, lno_eta_tdep is false.
!
if (Eaver<tini .or. lno_eta_tdep) then
eta_tdep=eta_huge
else
if (Baver<tini) then
eta_tdep=6.*pi**3*Hscript/echarge**3/Eaver
else
eta_tdep=6.*pi**2*Hscript/echarge**3*tanh(pi*Baver/Eaver)/Baver
endif
endif
!
! Compute sigmaB. Note that eta_tdep=0 for Baver=0.
!
! if (lsigmaB_contribution) then
! if (Eaver<tini) then
! etaB_tdep_B1=eta_huge
! else
! if (Baver<tini) then
! etaB_tdep_B1=6.*pi**3*Hscript/echarge**3/(Eaver*Baver)
! else
! etaB_tdep_B1=6.*pi**2*Hscript/echarge**3*tanh(pi*Baver/Eaver)/(Eaver*Baver)
! endif
! endif
! endif
!XX
! eta_tdep
!
case ('mean-field-local')
if (iex>0) then
Eabs=sqrt(f(l1:l2,m,n,iex)**2+f(l1:l2,m,n,iey)**2+f(l1:l2,m,n,iez)**2)
else
call fatal_error('calc_pencils_magnetic_pencpar','electric field must be computed')
endif
Babs=sqrt(p%b2)
!
! Note that for Babs=0, eta_xtdep=0
!
where (Eabs<tini)
eta_xtdep=eta_huge
elsewhere
where (Babs<tini)
eta_xtdep=6.*pi**3*Hscript/echarge**3/Eabs
elsewhere
eta_xtdep=6.*pi**2*Hscript/echarge**3*tanh(pi*Babs/Eabs)/Babs
endwhere
endwhere
case default
endselect
!
! endif from lresi_eta_tdep
!
endif
endif
!
! Check whether or not the displacement current is being computed.
! When iex>0, eta_total is not yet set, so we must do it here.
! Note, however, that p%jj_ohm can also be computed in disp_current,
! so we must not overwrite it here.
!
if (iex>0) then
if (lresi_eta_tdep) then
if (lresi_eta_xtdep) call fatal_error('calc_pencils_magnetic_pencpar', &
'lresi_eta_tdep must be false if lresi_eta_xtdep is true')
eta_total=eta_tdep
elseif (lresi_eta_xtdep) then
eta_total=eta_xtdep
else
!
! Must not overwrite jj_ohm here.
! Need to check that it is still always initialized.
!
!p%jj=0.
!p%jj_ohm=0.
eta_total=eta
endif
!
if (lvacuum) then
p%jj=0.
p%jj_ohm=0.
eta_total=huge1
else
!
! The Ohm's current is independent of loverride_ee2, etc.
! AB: eta_total and the rest are pencils, but it complains about inconsistent ranks. So I put (1).
! When the eta:s below are not known. p%jj_ohm may already have been computed in disp_current.
! Whether it works with lohm_evolve needs to be checked.
!
if (lresi_eta_tdep .or. lresi_eta_xtdep .or. eta/=0.) then
print*,'AXEL: should not be here (eta) ... '
if (lohm_evolve) then
p%jj_ohm=f(l1:l2,m,n,ijx:ijz)
else
if (learly_set_el_pencil) p%el=f(l1:l2,m,n,iex:iez)
do j=1,3
p%jj_ohm(:,j)=(p%el(:,j)+scl_uxb_in_ohm*p%uxb(:,j))*mu01/eta_total
enddo
endif
endif
!
! In (hopefully) all other cases, p%jj_ohm is either initialized
! to zero or known from disp_current, but can check here:
!
if (ip<9) print*,'AXEL: p%jj_ohm(1,:)=',p%jj_ohm(1,:)
!
! Compute current for Lorentz force.
! Note that loverride_ee2 is a "permanent" switch,
! i.e., it is the same for the entire run.
! There is the option to add in the displacement current,
! if ladd_disp_current_from_aux=T.
!
if (loverride_ee2) then
if (ladd_disp_current_from_aux) then
if (iedotx>0 .and. iedotz>0) then
p%jj=mu01*p%curlb-c_light21*f(l1:l2,m,n,iedotx:iedotz)
else
call fatal_error('calc_pencils_magnetic_pencpar', &
'need leedot_as_aux=T in special/disp_current')
endif
else
p%jj=mu01*p%curlb
endif
else
!
! If not loverride_ee2, then the current in the Lorentz force is the same
! as the Ohmic current.
!
p%jj=p%jj_ohm
endif
endif
else
!
! Go here in standard MHD if no displacement current exists.
! In that case, no ohmic current is needed or used.
!
p%jj=mu01*p%curlb
p%jj_ohm=0.
endif
!
! Add external j-field.
!
do j=1,3
if (iglobal_jext(j)/=0) p%jj(:,j)=p%jj(:,j)+f(l1:l2,m,n,iglobal_jext(j))
enddo
!
! Add an external J-field (for the Bell instability).
!
if (lJ_ext) then
if (J_ext_quench/=0) then
quench=1./(1.+J_ext_quench*p%b2)
do j=1,3
p%jj(:,j)=p%jj(:,j)-J_ext(j)*quench
enddo
else
do j=1,3
p%jj(:,j)=p%jj(:,j)-J_ext(j)
enddo
endif
endif
endif
! exa
if (lpenc_loc(i_exa)) call cross_mn(-p%uxb+eta*p%jj,p%aa,p%exa)
! exatotal
if (lpenc_loc(i_exatotal)) then
do j=1,3
tmp(:,j) = eta_total*p%jj(:,j)
enddo
call cross_mn(-p%uxb+tmp,p%aa,p%exatotal)
endif
! j2
if (lpenc_loc(i_j2)) call dot2_mn(p%jj,p%j2)
! jb
if (lpenc_loc(i_jb)) call dot_mn(p%jj,p%bbb,p%jb)
! va2
if (lpenc_loc(i_va2)) then
p%va2=p%b2*mu01*p%rho1
if (lcheck_positive_va2 .and. minval(p%va2)<0.0) then !MR: better some tiny value for 0?
print*, 'calc_pencils_magnetic: Alfven speed is imaginary!'
print*, 'calc_pencils_magnetic: it, itsub, iproc=', it, itsub, iproc_world
print*, 'calc_pencils_magnetic: m, y(m), n, z(n)=', m, y(m), n, z(n)
p%va2=abs(p%va2)
endif
endif
! eta_va
if (lpenc_loc(i_etava)) then
if (lresi_vAspeed) then
p%etava = eta_va * sqrt(p%va2)/vArms
if (va_min > 0.) where (p%etava < va_min) p%etava = va_min
else
p%etava = mu0 * eta_va * dxmax * sqrt(p%va2)
if (eta_min > 0.) where (p%etava < eta_min) p%etava = 0.
endif
endif
! gradient of va
if (lpenc_loc(i_gva).and.lalfven_as_aux) then
call grad(f,ialfven,p%gva)
if (lresi_vAspeed) then
do i=1,3
if (va_min > 0.) where (p%etava < va_min) p%gva(:,i) = 0.
enddo
endif
endif
! eta_j
if (lpenc_loc(i_etaj)) then
p%etaj = mu0 * eta_j * dxmax**2 * sqrt(mu0 * p%j2 * p%rho1)
if (eta_min > 0.) where (p%etaj < eta_min) p%etaj = 0.
endif
! eta_j2
if (lpenc_loc(i_etaj2)) then
p%etaj2 = etaj20 * p%j2 * p%rho1
if (eta_min > 0.) where (p%etaj2 < eta_min) p%etaj2 = 0.
endif
! eta_jrho
if (lpenc_loc(i_etajrho)) then
p%etajrho = mu0 * eta_jrho * dxmax * sqrt(p%j2) * p%rho1
if (eta_min > 0.) where (p%etajrho < eta_min) p%etajrho = 0.
endif
! jxb
if (lpenc_loc(i_jxb)) call cross_mn(p%jj,p%bb,p%jxb)
!
! cosjb
if (lpenc_loc(i_cosjb)) then
do ix=1,nx
if ((abs(p%j2(ix))<=tini).or.(abs(p%b2(ix))<=tini))then
p%cosjb(ix)=0.
else
p%cosjb(ix)=p%jb(ix)/sqrt(p%j2(ix)*p%b2(ix))
endif
enddo
if (lpencil_check_at_work) then
! map penc0 value back to interval [-1,1]
p%cosjb = modulo(p%cosjb + 1.0, 2.0) - 1
endif
endif
! jparallel and jperp
if (lpenc_loc(i_jparallel).or.lpenc_loc(i_jperp)) then
p%jparallel=sqrt(p%j2)*p%cosjb
p%jperp=sqrt(p%j2)*sqrt(abs(1-p%cosjb**2))
endif
! jxbr
if (lpenc_loc(i_jxbr)) then
rho1_jxb=p%rho1
!
! Set rhomin_jxb>0 in order to limit the jxb term at very low densities.
! Set va2max_jxb>0 in order to limit the jxb term at very high Alfven speeds.
! Set va2power_jxb to an integer value in order to specify the power of the
! limiting term,
!
if (rhomin_jxb>0) rho1_jxb=min(rho1_jxb,1/rhomin_jxb)
if (va2max_jxb>0 .and. (.not. (betamin_jxb>0))) &
rho1_jxb = rho1_jxb * (1+(p%va2/va2max_jxb)**va2power_jxb)**(-1.0/va2power_jxb)
if (betamin_jxb>0) then
va2max_beta = p%cs2/betamin_jxb*2.0*gamma1
if (va2max_jxb > 0) va2max_beta=min(va2max_beta,va2max_jxb)
rho1_jxb = rho1_jxb * (1.+(p%va2/va2max_beta)**va2power_jxb)**(-1.0/va2power_jxb)
endif
!MR: Why no Boris correction here? See calc of advec_va2 below!
call multsv_mn(rho1_jxb,p%jxb,p%jxbr)
endif
! jxbr2
if (lpenc_loc(i_jxbr2)) call dot2_mn(p%jxbr,p%jxbr2)
! ub
if (lpenc_loc(i_ub)) call dot_mn(p%uu,p%bb,p%ub)
! ob
if (lpenc_loc(i_ob)) call dot_mn(p%oo,p%bb,p%ob)
! uj
if (lpenc_loc(i_uj)) call dot_mn(p%uu,p%jj,p%uj)
! cosub
if (lpenc_loc(i_cosub)) then
do ix=1,nx
if ((abs(p%u2(ix))<=tini).or.(abs(p%b2(ix))<=tini)) then
p%cosub(ix)=0.
else
p%cosub(ix)=p%ub(ix)/sqrt(p%u2(ix)*p%b2(ix))
endif
enddo
if (lpencil_check) then
! map penc0 value back to interval [-1,1]
p%cosub = modulo(p%cosub + 1.0, 2.0) - 1
endif
endif
! uxb2
if (lpenc_loc(i_uxb2)) call dot2_mn(p%uxb,p%uxb2)
! uxj
if (lpenc_loc(i_uxj)) call cross_mn(p%uu,p%jj,p%uxj)
! chibp
! FG: 23-05-24 GNU Fortran (Ubuntu 11.4.0-1ubuntu1~22.04) 11.4.0
! FG: 27-02-25 GNU Fortran (Ubuntu 13.3.0-6ubuntu2~24.04) 13.3.0
! atan2: Program received signal SIGFPE: Floating-point exception - erroneous arithmetic operation.
! added tini to exclude 0,0 argument
! not required for GNU 9.4.0 and 11.2.0 ???
!
if (lpenc_loc(i_chibp)) p%chibp=atan2(p%bb(:,2),p%bb(:,1)+tini)+.5*pi
! StokesI
if (lpenc_loc(i_StokesI)) p%StokesI=(p%bb(:,1)**2+p%bb(:,2)**2)**exp_epspb
!
! StokesQ, StokesU, StokesQ1, and StokesU1
!
if (lncr_correlated) then
StokesI_ncr=p%StokesI*p%b2
if (lpenc_loc(i_StokesQ)) p%StokesQ=-StokesI_ncr*cos(2.*p%chibp)
if (lpenc_loc(i_StokesU)) p%StokesU=-StokesI_ncr*sin(2.*p%chibp)
if (lpenc_loc(i_StokesQ1)) p%StokesQ1=+StokesI_ncr*sin(2.*p%chibp)*p%bb(:,3)
if (lpenc_loc(i_StokesU1)) p%StokesU1=-StokesI_ncr*cos(2.*p%chibp)*p%bb(:,3)
elseif (lncr_anticorrelated) then
StokesI_ncr=p%StokesI/(1.+ncr_quench*p%b2)
if (lpenc_loc(i_StokesQ)) p%StokesQ=-StokesI_ncr*cos(2.*p%chibp)
if (lpenc_loc(i_StokesU)) p%StokesU=-StokesI_ncr*sin(2.*p%chibp)
if (lpenc_loc(i_StokesQ1)) p%StokesQ1=+StokesI_ncr*sin(2.*p%chibp)*p%bb(:,3)
if (lpenc_loc(i_StokesU1)) p%StokesU1=-StokesI_ncr*cos(2.*p%chibp)*p%bb(:,3)
else
if (lpenc_loc(i_StokesQ)) p%StokesQ=-p%StokesI*cos(2.*p%chibp)
if (lpenc_loc(i_StokesU)) p%StokesU=-p%StokesI*sin(2.*p%chibp)
if (lpenc_loc(i_StokesQ1)) p%StokesQ1=+p%StokesI*sin(2.*p%chibp)*p%bb(:,3)
if (lpenc_loc(i_StokesU1)) p%StokesU1=-p%StokesI*cos(2.*p%chibp)*p%bb(:,3)
endif
! beta1
if (lpenc_loc(i_beta1)) p%beta1=0.5*p%b2*mu01/p%pp
! beta
if (lpenc_loc(i_beta)) p%beta = 2.0 * mu0 * p%pp / max(p%b2, epsilon(1.0))
! djuidjbi
if (lpenc_loc(i_djuidjbi)) call multmm_sc(p%uij,p%bij,p%djuidjbi)
! jo
if (lpenc_loc(i_jo)) call dot(p%jj,p%oo,p%jo)
! ujxb
if (lpenc_loc(i_ujxb)) call dot_mn(p%uu,p%jxb,p%ujxb)
! Bk*Bk,i = grad(b^2/2)
if (lpenc_loc(i_gb22)) call multmv_transp(p%bij,p%bb,p%gb22)
! u.grad(b)
if (lpenc_loc(i_ugb)) call multmv(p%bij,p%uu,p%ugb)
! u.grad(b^2)
if (lpenc_loc(i_ugb22)) call dot_mn(p%uu,p%gb22,p%ugb22)
!
! div(u)*b
if (lpenc_loc(i_bdivu)) then
do i=1,3
p%bdivu(:,i)=p%bb(:,i)*p%divu
enddo
endif
! b.grad(u)
if (lpenc_loc(i_bgu)) call multmv(p%uij,p%bb,p%bgu)
! bgb
if (lpenc_loc(i_bgb)) then
call multmv(p%bij,p%bb,p%bgb)
endif
!
! bgbp
if (lpenc_loc(i_bgbp)) then
call dot_mn(p%bb,p%bgb,bbgb)
call multsv(bbgb*p%b21,p%bb,p%bgbp)
endif
!
! u.(B.gradB)
if (lpenc_loc(i_ubgbp)) call dot_mn(p%uu,p%bgbp,p%ubgbp)
! oxu
!AB if (lpenc_loc(i_oxu)) call cross_mn(p%oo,p%uu,p%oxu)
! oxuxb
if (lpenc_loc(i_oxuxb)) call cross_mn(p%oxu,p%bb,p%oxuxb)
! jxbxb
if (lpenc_loc(i_jxbxb)) call cross_mn(p%jxb,p%bb,p%jxbxb)
! jxbrxb
if (lpenc_loc(i_jxbrxb)) call cross_mn(p%jxbr,p%bb,p%jxbrxb)
! glnrhoxb
if (lpenc_loc(i_glnrhoxb)) call cross_mn(p%glnrho,p%bb,p%glnrhoxb)
! del4a
if (lpenc_loc(i_del4a)) call del4v(f,iaa,p%del4a)
! hjj
if (lpenc_loc(i_hjj)) p%hjj = p%del4a
! hj2
if (lpenc_loc(i_hj2)) call dot2_mn(p%hjj,p%hj2)
! hjb
if (lpenc_loc(i_hjb)) call dot_mn(p%hjj,p%bb,p%hjb)
! coshjb
if (lpenc_loc(i_coshjb)) then
do ix=1,nx
if ((abs(p%hj2(ix))<=tini).or.(abs(p%b2(ix))<=tini))then
p%coshjb(ix)=0.
else
!p%coshjb(ix)=p%hjb(ix)/sqrt(p%hj2(ix)*p%b2(ix))
p%coshjb(ix)=p%hjb(ix)/(sqrt(p%hj2(ix))*sqrt(p%b2(ix)))
endif
enddo
if (lpencil_check_at_work) then
! map penc0 value back to interval [-1,1]
p%coshjb = modulo(p%coshjb + 1.0, 2.0) - 1
endif
endif
! hjparallel and hjperp
if (lpenc_loc(i_hjparallel).or.lpenc_loc(i_hjperp)) then
p%hjparallel=sqrt(p%hj2)*p%coshjb
p%hjperp=sqrt(p%hj2)*sqrt(abs(1-p%coshjb**2))
endif
! del6a
if (lpenc_loc(i_del6a)) call del6v(f,iaa,p%del6a)
! e3xa
if (lpenc_loc(i_e3xa)) then
call cross_mn(-p%uxb+eta_hyper3*p%del6a,p%aa,p%e3xa)
endif
! oxj
if (lpenc_loc(i_oxj)) call cross_mn(p%oo,p%jj,p%oxJ)
! jij
if (lpenc_loc(i_jij)) then
do j=1,3
do i=1,3
p%jij(:,i,j)=.5*(p%bij(:,i,j)+p%bij(:,j,i))
enddo
enddo
endif
! d6ab
if (lpenc_loc(i_d6ab)) call dot_mn(p%del6a,p%bb,p%d6ab)
! sj
if (lpenc_loc(i_sj)) call multmm_sc(p%sij,p%jij,p%sj)
! ss12
if (lpenc_loc(i_ss12)) p%ss12=sqrt(abs(p%sj))
! vmagfric
if (lpenc_loc(i_vmagfric).and.numag/=0.0) then
tmp1=mu01/(numag*(B0_magfric/unit_magnetic**2+p%b2))
do i=1,3
p%vmagfric(:,i)=abs(p%jxb(:,i))*tmp1
enddo
endif
! Lam
if (lpenc_loc(i_Lam)) then
if (lcoulomb) then
p%Lam=f(l1:l2,m,n,iLam)
else
call fatal_error('calc_pencils_magnetic_pencpar', 'Coulomb gauge needs to be invoked for Lam')
endif
endif
!
! Store bb, jj or jxb in auxiliary variable if requested.
! Just neccessary immediately before writing snapshots, but how would we
! know we are?
!
if (lbb_as_aux .and. .not. lbb_as_comaux) f(l1:l2,m,n,ibx:ibz) = p%bb
if (ljj_as_aux .and. .not. ljj_as_comaux) f(l1:l2,m,n,ijx:ijz) = p%jj
if (ljxb_as_aux) f(l1:l2,m,n,ijxbx:ijxbz)=p%jxb
if (lpenc_loc(i_bb_sph).and.lbb_sph_as_aux) p%bb_sph(:,1:3)=f(l1:l2,m,n,ibb_sphr:ibb_sphp)
!
! Store uxb, ugb, or bgu in auxiliary variable if requested
!
if (luxb_as_aux) f(l1:l2,m,n,iuxbx:iuxbz) = p%uxb
if (lugb_as_aux) f(l1:l2,m,n,iugbx:iugbz) = p%ugb
if (lbgu_as_aux) f(l1:l2,m,n,ibgux:ibguz) = p%bgu
if (lbdivu_as_aux) f(l1:l2,m,n,ibdivux:ibdivuz) = p%bdivu
!
! Calculate magnetic mean-field pencils.
! This should always be done after calculating magnetic pencils.
!
if (lmagn_mf) call calc_pencils_magn_mf(f,p)
!
! Ambipolar diffusion pencil
!
if (lpenc_loc(i_nu_ni1)) call set_ambipolar_diffusion(p)
!
! reduced speed of light pencil
!
if (lpenc_loc(i_clight2)) then
if (va2max_boris > 0) then
p%clight2=spread(va2max_boris,1,nx)
else
if (lcartesian_coords) then
p%clight2 = max(dble(cmin)**2,c_light**2/(1.+max(z(n),0.0)**8)+max(25.0*maxval(p%u2),maxval(p%cs2)))
else if (lspherical_coords) then
p%clight2 = spread(max(cmin**2,25*maxval(p%u2),maxval(p%cs2)),1,nx)
endif
endif
p%gamma_A2=p%clight2/(p%clight2+p%va2+tini)
endif
!
! Dummy pencils. At the moment, we say that magnetic calculates the p%el pencil,
! but in reality it is calculated in one of the special routines (disp_current)
! or in magnetic/maxwell.
!
!! if (lpenc_loc(i_el).or.lpenc_loc(i_e2)) call fatal_error("calc_pencils_magnetic_pencpar",&
!! "Electric field is not currently computed in magnetic")
! if ((lpenc_loc(i_el).or.lpenc_loc(i_e2)).and.headt) &
! print*,'lets hope p%el and p%e2 are computed elsewhere...'
!
! Add ``va^2/dx^2'' contribution to timestep.
! Consider advective timestep only when lhydro=T.
!
if (lupdate_courant_dt) then
if (lhydro.and.llorentzforce) then
rho1_jxb=p%rho1
if (rhomin_jxb>0) rho1_jxb=min(rho1_jxb,1/rhomin_jxb)
if (va2max_jxb>0 .and. (.not. (betamin_jxb>0))) &
rho1_jxb = rho1_jxb * (1+(p%va2/va2max_jxb)**va2power_jxb)**(-1.0/va2power_jxb)
if (betamin_jxb>0) then
va2max_beta = p%cs2/betamin_jxb*2.0*gamma1
if (va2max_jxb > 0) va2max_beta=min(va2max_beta,va2max_jxb)
rho1_jxb = rho1_jxb * (1+(p%va2/va2max_beta)**va2power_jxb)**(-1.0/va2power_jxb)
endif
if (lboris_correction) then
if (va2max_boris>0) rho1_jxb = rho1_jxb * (1+(p%va2/va2max_boris)**2.)**(-0.5)
if (cmin>0) rho1_jxb = rho1_jxb * (1+(p%va2/p%clight2)**2.)**(-0.5)
endif
p%advec_va2=sum((p%bb*dline_1)**2,2)*mu01*rho1_jxb
else
p%advec_va2=0.
endif
!
!WL: don't know if this is correct, but it's the only way I can make
! some 1D and 2D samples work when the non-existent direction has the
! largest velocity (like a 2D rz slice of a Keplerian disk that rotates
! on the phi direction)
! Please check
!
if (lisotropic_advection) then
if (dimensionality<3) p%advec_va2=p%va2*dxyz_2
endif
!
!mcnallcp: If hall_term is on, the fastest alfven-type mode is the Whistler wave at the grid scale.
! Since the Alfven waves split into the fast whistler mode, the old advec_va2 is not right anymore.
! This is the generalization for Hall-MHD.
! This is not used in EMHD simulations.
!
if (lhydro.and.hall_term/=0.0) p%advec_va2=( (p%bb(:,1)*dline_1(:,1)*( hall_term*pi*dline_1(:,1)*mu01 &
+sqrt(mu01*p%rho1 + (hall_term*pi*dline_1(:,1)*mu01)**2 ) ))**2 &
+(p%bb(:,2)*dline_1(:,2)*( hall_term*pi*dline_1(:,2)*mu01 &
+sqrt(mu01*p%rho1 + (hall_term*pi*dline_1(:,2)*mu01)**2 ) ))**2 &
+(p%bb(:,3)*dline_1(:,3)*( hall_term*pi*dline_1(:,3)*mu01 &
+sqrt(mu01*p%rho1 + (hall_term*pi*dline_1(:,3)*mu01)**2 ) ))**2 &
)
!MR: Why is advec_va2 not cumulative?
if (notanumber(p%advec_va2)) then
if (lproc_print) then
print*, 'calc_pencils_magnetic: advec_va2 =',p%advec_va2
if (.not.allproc_print) lproc_print=.false.
endif
endif
advec2=advec2+p%advec_va2
if (lmagneto_friction) then
call dot2(p%vmagfric,tmp1)
advec2=advec2 + tmp1
endif
!
endif
!
endsubroutine calc_pencils_magnetic_pencpar
!***********************************************************************
subroutine set_ambipolar_diffusion(p)
!
! Subroutine to choose between various models of ion density
! to enter in the ambipolar diffusion calculation. The "scale-density"
! model assumes equilibrium between ionization and recombination:
!
! ksi * rho = beta * rho_i * rho_e
! ~ beta * rho_i^2
!
! wkere ksi is ionization rate, beta the recombination rate, and
! rho, rho_i, and rho_e are the neutral, ion, and electron density,
! respectively, with rho >> rho_i ~ rho_e. Solving for rho_i,
!
! rho_i = sqrt(ksi*rho/beta)
! propto sqrt(rho)
!
! This is implemented as ionization-equilibrium below. The proportionality
! coefficients are incorporated into nu_ni1.
!
! 08-mar-13/wlad: coded
!
type (pencil_case) :: p
!
select case (ambipolar_diffusion)
!
case('constant'); p%nu_ni1=nu_ni1
case('ionization-equilibrium'); p%nu_ni1=nu_ni1*sqrt(p%rho1)
case('ionization-yH'); p%nu_ni1=nu_ni1*sqrt(p%rho1)*(1.-p%yH)/p%yH
case default
call fatal_error('set_ambipolar_diffusion','no such ambipolar_diffusion: '//trim(ambipolar_diffusion))
endselect
!
endsubroutine set_ambipolar_diffusion
!***********************************************************************
subroutine diamagnetism(p)
!
! Compute diamagnetism
!
use Sub
!
real, dimension (nx) :: chi_diamag
real, dimension (nx,3) :: gchi_diamag, Bk_Bki, jj_diamag, tmp
type (pencil_case) :: p
!
intent(inout) :: p
!
! cmpute chi, and gradchi
!
chi_diamag=B2_diamag/p%b2
!
! Add (1/2)*grad[qp*B^2]. This initializes p%jxb_mf.
!
! call multmv_transp(p%bij,p%bb,Bk_Bki) !=1/2 grad B^2
! call multsv(-.5*chi_diamag/p%b2,Bk_Bki,gchi_diamag)
!AB: now outsourced p%gb22 = grad(B^2/2)
call multsv(chi_diamag/p%b2,p%gb22,gchi_diamag)
call cross(gchi_diamag,p%bb,jj_diamag)
call multsv_add(jj_diamag,chi_diamag,p%jj,tmp)
jj_diamag=tmp
!
! update current density
!
p%jj=p%jj+jj_diamag
!
endsubroutine diamagnetism
!***********************************************************************
subroutine calc_aaxyaver(aa_xyaver,f)
!
! 12-2-2025/TP: carved from daa_dt to separate average calculations. To get it running on the GPU would have to happen in
! before_boundary or after_boundary
!
real, dimension(nx,3) :: aa_xyaver
real, dimension(mx,my,mz,mfarray) :: f
integer :: j
integer, parameter :: nxy=nxgrid*nygrid
do j=1,3
aa_xyaver(:,j)=sum(f(l1:l2,m1:m2,n,j+iax-1))/nxy
enddo
endsubroutine calc_aaxyaver
!***********************************************************************
subroutine daa_dt(f,df,p)
!
! Magnetic field evolution.
!
! Calculate dA/dt=uxB+3/2 Omega_0 A_y x_dir -eta mu_0 J.
! Add jxb/rho to momentum equation.
! Add eta mu_0 j2/rho to entropy equation.
!
! 22-nov-01/nils: coded
! 1-may-02/wolf: adapted for pencil_modular
! 17-jun-03/ulf: added bx^2, by^2 and bz^2 as separate diagnostics
! 8-aug-03/axel: introduced B_ext21=1./B_ext**2, and set =1 to avoid div. by 0
! 12-aug-03/christer: added alpha effect (alpha in the equation above)
! 26-may-04/axel: ambipolar diffusion added
! 18-jun-04/axel: Hall term added
! 9-apr-12/MR: upwinding for ladvective_gauge=F generalized
! 31-mar-13/axel: Stokes parameter integration from synchrotron emission
! 25-aug-13/MR: simplified calls of save_name_sound
! 15-oct-15/MR: changes for slope-limited diffusion
! 14-apr-16/MR: changes for Yin-Yang: only yz slices at the moment!
! 4-aug-17/axel: implemented terms for ultrarelativistic EoS
! 03-apr-20/joern: restructured and fixed slope-limited diffusion
!
use Debug_IO, only: output_pencil
use Deriv, only: der6
use Special, only: special_calc_magnetic
use Sub
use General, only: transform_thph_yy, notanumber
real, dimension (mx,my,mz,mfarray) :: f
real, dimension (mx,my,mz,mvar) :: df
type (pencil_case) :: p
!
intent(in) :: p
intent(inout):: f,df
!
real, dimension (nx,3) :: ujiaj,gua,ajiuj
real, dimension (nx,3) :: aa_xyaver
real, dimension (nx,3) :: geta,uxb_upw,tmp2
real, dimension (nx,3) :: dAdt, gradeta_shock, aa1, uu1, dJdt, del2jj
real, dimension (nx,3,3) :: d_sld_flux
real, dimension (nx) :: ftot, dAtot
real, dimension (nx) :: peta_shock
real, dimension (nx) :: sign_jo,tmp1
real, dimension (nx) :: eta_mn,etaSS,eta_heat
real, dimension (nx) :: vdrift, va2max_beta
real, dimension (nx) :: del2aa_ini,tanhx2,advec_hall,advec_hypermesh_aa
real, dimension(nx) :: eta_BB, prof
real, dimension(3) :: B_ext
real :: tmp, eta_out1, cosalp, sinalp, hall_term_, tau1_jj
real, parameter :: OmegaSS=1.0
integer :: i,j,k,ju,ix,nphi
integer, parameter :: nxy=nxgrid*nygrid
!
! Identify module and boundary conditions.
!
call timing('daa_dt','entered',mnloop=.true.)
if (headtt.or.ldebug) print*,'daa_dt: SOLVE'
if (headtt) then
call identify_bcs('Ax',iax)
call identify_bcs('Ay',iay)
call identify_bcs('Az',iaz)
if(lbb_as_comaux) then
call identify_bcs('Bx',ibx)
call identify_bcs('By',iby)
call identify_bcs('Bz',ibz)
endif
if(ljj_as_comaux) then
call identify_bcs('Jx',ijx)
call identify_bcs('Jy',ijy)
call identify_bcs('Jz',ijz)
endif
if(lslope_limit_diff) then
call identify_bcs('sld_char',isld_char)
endif
endif
!
! set dAdt to zero at the beginning of each execution of this routine
!
dAdt=0.
Fmax=1./impossible
dAmax=1./impossible
ssmax=1./impossible
if (lfirstpoint) lproc_print=.true.
!
! Replace B_ext locally to accommodate its time dependence.
!
call get_bext(B_ext)
!
! Add jxb/rho to momentum equation.
!
if (lhydro) then
if (.not.lkinematic) then
if (llorentzforce) then
if (lboris_correction) then
!
! Following Eq. 34 of Gombosi et al. 2002 for Boris correction. Can work with
! only const gravity at present
!
df(l1:l2,m,n,iux)=df(l1:l2,m,n,iux)+p%gamma_A2*p%jxbr(:,1)+&
(p%ugu(:,1)+p%rho1gpp(:,1)-p%gg(:,1))*(1-p%gamma_A2)-&
mu01*(p%gamma_A2**2*p%rho1/p%clight2)* &
(p%bb(:,1)**2*(p%ugu(:,1)+p%rho1gpp(:,1)-p%gg(:,1))+&
p%bb(:,1)*p%bb(:,2)*(p%ugu(:,2)+p%rho1gpp(:,2)-p%gg(:,2))+&
p%bb(:,1)*p%bb(:,3)*(p%ugu(:,3)+p%rho1gpp(:,3)-p%gg(:,3)))
df(l1:l2,m,n,iuy)=df(l1:l2,m,n,iuy)+p%gamma_A2*p%jxbr(:,2)+&
(p%ugu(:,2)+p%rho1gpp(:,2)-p%gg(:,2))*(1-p%gamma_A2)-&
mu01*(p%gamma_A2**2*p%rho1/p%clight2)* &
(p%bb(:,2)**2*(p%ugu(:,2)+p%rho1gpp(:,2)-p%gg(:,2))+&
p%bb(:,2)*p%bb(:,1)*(p%ugu(:,1)+p%rho1gpp(:,1)-p%gg(:,1))+&
p%bb(:,2)*p%bb(:,3)*(p%ugu(:,3)+p%rho1gpp(:,3)-p%gg(:,3)))
df(l1:l2,m,n,iuz)=df(l1:l2,m,n,iuz)+p%gamma_A2*p%jxbr(:,3)+&
(p%ugu(:,3)+p%rho1gpp(:,3)-p%gg(:,3))*(1-p%gamma_A2)-&
mu01*(p%gamma_A2**2*p%rho1/p%clight2)* &
(p%bb(:,3)**2*(p%ugu(:,3)+p%rho1gpp(:,3)-p%gg(:,3))+&
p%bb(:,3)*p%bb(:,1)*(p%ugu(:,1)+p%rho1gpp(:,1)-p%gg(:,1))+&
p%bb(:,3)*p%bb(:,2)*(p%ugu(:,2)+p%rho1gpp(:,2)-p%gg(:,2)))
elseif (llorentz_rhoref) then
df(l1:l2,m,n,iux:iuz)=df(l1:l2,m,n,iux:iuz)+p%jxb*rhoref1
else
if (lrelativistic_eos) then
call dot(p%uu,p%jxbr,tmp1)
df(l1:l2,m,n,ilnrho)=df(l1:l2,m,n,ilnrho)+tmp1
df(l1:l2,m,n,iux:iuz)=df(l1:l2,m,n,iux:iuz)+.75*p%jxbr
else
if (iphiuu==0) then
!
! Add Lorentz force, JxB in the conservative case and JxB/rho otherwise.
! But also in the usual case, we have the option to *ignore* the 1/rho term
! in the Lorentz force if we want to test vorticity production from this term.
!
if (lconservative) then
df(l1:l2,m,n,iux:iuz)=df(l1:l2,m,n,iux:iuz)+p%jxb
else
if (lignore_1rho_in_Lorentz) then
df(l1:l2,m,n,iux:iuz)=df(l1:l2,m,n,iux:iuz)+p%jxb
else
select case (ascale_type)
case ('default'); df(l1:l2,m,n,iux:iuz)=df(l1:l2,m,n,iux:iuz)+p%jxbr
case ('superconformal'); df(l1:l2,m,n,iux:iuz)=df(l1:l2,m,n,iux:iuz)+ascale*p%jxbr
case ('general'); df(l1:l2,m,n,iux:iuz)=df(l1:l2,m,n,iux:iuz)+ascale**(2.*nconformal-3.)*p%jxbr
endselect
endif
endif
else
df(l1:l2,m,n,iphiuu)=df(l1:l2,m,n,iphiuu)-.5*(p%b2-B_ext2)
endif
endif
endif
endif
endif
endif
!
! The following is only needed when the displacement current is not being solved for.
! To check this, we can check whether lspecial=T and iex/=0.
! We therefore continue only when iex>0.
!
if (iex==0.or.loverride_ee) then
!
! Restivivity term
!
! Because of gauge invariance, we can add the gradient of an arbitrary scalar
! field Phi to the induction equation without changing the magnetic field,
! dA/dt = u x B - eta j + grad(Phi).
!
! If lweyl_gauge=T, we choose Phi = const. and solve
! dA/dt = u x B - eta mu0 j.
!
! Else, if lweyl_gauge=F, we make the gauge choice Phi = eta div(A)
! and thus solve
! dA/dt = u x B + eta laplace(A) + div(A) grad(eta).
!
! Note: lweyl_gauge=T is so far only implemented for some resistivity types.
!
if (headtt) print*, 'daa_dt: iresistivity=', iresistivity
!
fres=0.
eta_total=0.; diffus_eta2=0.; diffus_eta3=0.
!
! Uniform resistivity
!
if (lresi_eta_const) then
if (.not. limplicit_resistivity) then
if (lweyl_gauge) then
fres = fres - eta * mu0 * p%jj
else
fres = fres + eta * p%del2a
endif
!
! whatever the gauge is, add an external space-varying electric field
!
if (ladd_efield) then
tanhx2 = tanh( x(l1:l2) )*tanh( x(l1:l2) )
del2aa_ini = ampl_efield*(-2 + 8*tanhx2 - 6*tanhx2*tanhx2 )
fres(:,3) = fres(:,3) - eta*mu0*del2aa_ini
endif
eta_total = eta_total + eta
endif
endif
!
! Time-dependent resistivity
! If both z and t dependent, then use eta_tdep for del2 (in non-Weyl),
! and -(eta_zdep-1.)*eta_tdep*mu0*p%jj, where eta_zdep < 1 is assumed.
! Remember that none of this is accessed if displacement current is included.
!
if (lresi_eta_tdep) then
if (lresi_eta_ztdep) then
if (lweyl_gauge) then
fres = fres -eta_tdep* feta_ztdep(n) *mu0*p%jj
else
fres = fres+eta_tdep*p%del2a-eta_tdep*(feta_ztdep(n)-1.)*mu0*p%jj
endif
else
if (lweyl_gauge) then
fres = fres - eta_tdep * mu0 * p%jj
else
fres = fres + eta_tdep * p%del2a
endif
endif
eta_total = eta_total + eta_tdep
endif
!
! z-dependent resistivity
!
if (lresi_zdep) then
if (.not. limplicit_resistivity) then
if (lweyl_gauge) then
fres = fres - eta_z(n) * mu0 * p%jj
else
do j = 1,3; fres(:,j) = fres(:,j) + eta_z(n) * p%del2a(:,j); enddo
fres(:,3) = fres(:,3) + geta_z(n) * p%diva
endif
eta_total = eta_total + eta_z(n)
else !MR: What about Weyl gauge here?
! Assuming geta_z(:,1) = geta_z(:,2) = 0
fres(:,3) = fres(:,3) + geta_z(n) * p%diva
if (lupdate_courant_dt) maxadvec = maxadvec + abs(geta_z(n)) * dz_1(n)
endif
endif
!
if (lresi_sqrtrhoeta_const) then
if (lweyl_gauge) then
do j=1,3
fres(:,j)=fres(:,j)-eta*sqrt(p%rho1)*mu0*p%jj(:,j)
enddo
else
do j=1,3
fres(:,j)=fres(:,j)+eta*sqrt(p%rho1) * (p%del2a(:,j)-0.5*p%diva*p%glnrho(:,j))
enddo
endif
eta_total=eta_total+eta*sqrt(p%rho1)
endif
!
! Anisotropic tensor, eta_ij = eta*delta_ij + eta1*qi*qj; see
! Ruderman & Ruzmaikin (1984) and Plunian & Alboussiere (2020).
!
if (lresi_eta_aniso) then
cosalp=cos(alp_aniso*dtor)
sinalp=sin(alp_aniso*dtor)
if (eta1_aniso_r==0.) then
prof=eta1_aniso
else
prof=eta1_aniso*(1.-step(x(l1:l2),eta1_aniso_r,eta1_aniso_d))
endif
if (lquench_eta_aniso) prof=prof/(1.+quench_aniso*Arms)
fres(:,1)=fres(:,1)-prof*cosalp*(cosalp*p%jj(:,1)+sinalp*p%jj(:,2))
fres(:,2)=fres(:,2)-prof*sinalp*(cosalp*p%jj(:,1)+sinalp*p%jj(:,2))
eta_total=eta_total+abs(eta1_aniso)
endif
!
! Shakura-Sunyaev type resistivity (mainly just as a demo to show
! how resistivity can be made dependent on temperature.
! Since etaSS is nonuniform, we use this contribution only for -etaSS*JJ
! and keep the constant piece with +eta*del2A. (The divA term is eliminated
! by a suitable gauge transformation.) A sample run is checked in under
! pencil-runs/1d-tests/bdecay
!
if (lresi_etaSS) then
etaSS=alphaSSm*p%cs2/OmegaSS
do j=1,3
fres(:,j)=fres(:,j)-etaSS*p%jj(:,j)
enddo
eta_total=eta_total+etaSS
endif
!
if (lresi_xydep) then
do j=1,3
fres(:,j)=fres(:,j)+eta_xy(l1:l2,m)*p%del2a(:,j)+geta_xy(l1:l2,m,j)*p%diva
enddo
eta_total=eta_total+eta_xy(l1:l2,m)
endif
!
if (lresi_xdep) then
if (lweyl_gauge) then
do j=1,3
fres(:,j) = fres(:,j) - eta_x(l1:l2) * mu0 * p%jj(:,j)
enddo
else
do j=1,3
fres(:,j)=fres(:,j)+eta_x(l1:l2)*p%del2a(:,j)
enddo
fres(:,1)=fres(:,1)+geta_x(l1:l2)*p%diva
endif
eta_total=eta_total+eta_x(l1:l2)
endif
!
if (lresi_rdep) then
call eta_rdep(eta_r,geta_r,rdep_profile,p)
do j=1,3
fres(:,j)=fres(:,j)+eta_r*p%del2a(:,j)+geta_r(:,j)*p%diva
enddo
eta_total=eta_total+eta_r
endif
!
if (lresi_ydep) then
do j=1,3
fres(:,j)=fres(:,j)+eta_y(m)*p%del2a(:,j)
enddo
if (lspherical_coords) then
fres(:,2)=fres(:,2)+p%r_mn1*geta_y(m)*p%diva
else
fres(:,2)=fres(:,2)+geta_y(m)*p%diva
endif
eta_total=eta_total+eta_y(m)
endif
!
! Note that one has to use eta_hyper2 < 0 to have diffusion.
! I would have defined the sign the other way around (AB).
!
if (lresi_hyper2) then
fres=fres+eta_hyper2*p%del4a
if (lupdate_courant_dt) diffus_eta2=diffus_eta2+eta_hyper2
endif
!
if (lresi_hyper3) then
fres=fres+eta_hyper3*p%del6a
if (lupdate_courant_dt) diffus_eta3=diffus_eta3+eta_hyper3
endif
!
! Unlike for usual hyper2 and hyper3, where the coefficient is
! eta_hyper2 and eta_hyper3, respectively, it is here, in the
! t-dependent case, just eta. Note the minus sign for del4a.
!
if (lresi_hyper2_tdep) then
fres=fres-eta_tdep*p%del4a
if (lupdate_courant_dt) diffus_eta2=diffus_eta2+eta_tdep
endif
!
if (lresi_hyper3_tdep) then
fres=fres+eta_tdep*p%del6a
if (lupdate_courant_dt) diffus_eta3=diffus_eta3+eta_tdep
endif
!
if (lresi_hyper3_polar) then
do j=1,3
ju=j+iaa-1
do i=1,3
call der6(f,ju,tmp1,i,IGNOREDX=.true.)
fres(:,j)=fres(:,j)+eta_hyper3*pi4_1*tmp1*dline_1(:,i)**2
enddo
enddo
if (lupdate_courant_dt) diffus_eta3=diffus_eta3+eta_hyper3*pi4_1*dxmin_pencil**4
endif
!
if (lresi_hyper3_mesh) then
do j=1,3
ju=j+iaa-1
do i=1,3
call der6(f,ju,tmp1,i,IGNOREDX=.true.)
if (ldynamical_diffusion) then
fres(:,j) = fres(:,j) + eta_hyper3_mesh * tmp1 * dline_1(:,i)
else
fres(:,j) = fres(:,j)+eta_hyper3_mesh*pi5_1/60.*tmp1*dline_1(:,i)
endif
enddo
enddo
if (lupdate_courant_dt) then
if (ldynamical_diffusion) then
diffus_eta3 = diffus_eta3 + eta_hyper3_mesh
advec_hypermesh_aa = 0.0
else
advec_hypermesh_aa=eta_hyper3_mesh*pi5_1*sqrt(dxyz_2)
endif
advec2_hypermesh=advec2_hypermesh+advec_hypermesh_aa**2
endif
endif
!
if (lresi_hyper3_csmesh) then
do j=1,3
ju=j+iaa-1
do i=1,3
call der6(f,ju,tmp1,i,IGNOREDX=.true.)
if (ldynamical_diffusion) then
fres(:,j)=fres(:,j)+eta_hyper3_mesh*sqrt(p%cs2) * tmp1*dline_1(:,i)
else
fres(:,j)=fres(:,j)+eta_hyper3_mesh*sqrt(p%cs2) * pi5_1/60.*tmp1*dline_1(:,i)
endif
enddo
enddo
if (lupdate_courant_dt) then
if (ldynamical_diffusion) then
diffus_eta3=diffus_eta3+eta_hyper3_mesh*sqrt(p%cs2)
advec_hypermesh_aa=0.0
else
advec_hypermesh_aa=eta_hyper3_mesh*pi5_1*sqrt(dxyz_2*p%cs2)
endif
advec2_hypermesh=advec2_hypermesh+advec_hypermesh_aa**2
endif
endif
!
if (lresi_hyper3_strict) then
fres=fres+eta_hyper3*f(l1:l2,m,n,ihypres:ihypres+2)
if (lupdate_courant_dt) diffus_eta3=diffus_eta3+eta_hyper3
endif
!
if (lresi_hyper3_aniso) then
call del6fjv(f,eta_aniso_hyper3,iaa,tmp2)
fres=fres+tmp2
! Must divide by dxyz_6 here, because it is multiplied on later.
if (lupdate_courant_dt) diffus_eta3=diffus_eta3 + &
(eta_aniso_hyper3(1)*dline_1(:,1)**6 + &
eta_aniso_hyper3(2)*dline_1(:,2)**6 + &
eta_aniso_hyper3(3)*dline_1(:,3)**6)/dxyz_6
endif
!
if (lresi_shell) then
call eta_shell(p,eta_mn,geta)
do j=1,3
fres(:,j)=fres(:,j)+eta_mn*p%del2a(:,j)+geta(:,j)*p%diva
enddo
eta_total=eta_total+eta_mn
endif
!
if (lresi_eta_shock) then
if (lweyl_gauge) then
do i=1,3
fres(:,i)=fres(:,i)-eta_shock*p%shock*mu0*p%jj(:,i)
enddo
else
do i=1,3
fres(:,i)=fres(:,i)+eta_shock*(p%shock*p%del2a(:,i)+p%diva*p%gshock(:,i))
enddo
endif
eta_total=eta_total+eta_shock*p%shock
endif
!
if (lresi_eta_shock2) then
if (lweyl_gauge) then
do i=1,3
fres(:,i)=fres(:,i)-eta_shock2*p%shock**2*mu0*p%jj(:,i)
enddo
else
do i=1,3
fres(:,i)=fres(:,i)+eta_shock2*(p%shock**2*p%del2a(:,i)+2*p%shock*p%diva*p%gshock(:,i))
enddo
endif
eta_total=eta_total+eta_shock2*p%shock**2
endif
!
! diffusivity: eta-shock with vertical profile
!
if (lresi_eta_shock_profz) then
peta_shock = eta_shock + eta_shock_jump1*step(p%z_mn,eta_zshock,-eta_width_shock)
!
! MR: the following only correct in Cartesian geometry!
!
gradeta_shock(:,1) = 0.
gradeta_shock(:,2) = 0.
gradeta_shock(:,3) = eta_shock_jump1*der_step(p%z_mn,eta_zshock,-eta_width_shock)
if (lweyl_gauge) then
do i=1,3
fres(:,i)=fres(:,i)-peta_shock*p%shock*mu0*p%jj(:,i)
enddo
else
do i=1,3
fres(:,i)=fres(:,i)+ &
peta_shock*(p%shock*p%del2a(:,i)+p%diva*p%gshock(:,i))+p%diva*p%shock*gradeta_shock(:,i)
enddo
endif
eta_total=eta_total+peta_shock*p%shock
endif
!
! diffusivity: eta-shock with radial profile
!
if (lresi_eta_shock_profr) then
if (lspherical_coords.or.lsphere_in_a_box) then
tmp1=p%r_mn
else
tmp1=p%rcyl_mn
endif
peta_shock = eta_shock + eta_shock_jump1*step(tmp1,eta_xshock,eta_width_shock)
!
gradeta_shock(:,1) = eta_shock_jump1*der_step(tmp1,eta_xshock,eta_width_shock)
gradeta_shock(:,2) = 0.
gradeta_shock(:,3) = 0.
!
if (lweyl_gauge) then
do i=1,3
fres(:,i)=fres(:,i)-peta_shock*p%shock*mu0*p%jj(:,i)
enddo
else
do i=1,3
fres(:,i)=fres(:,i) + peta_shock*(p%shock*p%del2a(:,i)+p%diva*p%gshock(:,i))+ &
p%diva*p%shock*gradeta_shock(:,i)
enddo
endif
eta_total=eta_total+peta_shock*p%shock
endif
!
if (lresi_eta_shock_perp) then
if (lweyl_gauge) then
do i=1,3
fres(:,i)=fres(:,i)-eta_shock*p%shock_perp*mu0*p%jj(:,i)
enddo
else
do i=1,3
fres(:,i)=fres(:,i)+ eta_shock*(p%shock_perp*p%del2a(:,i)+p%diva*p%gshock_perp(:,i))
enddo
endif
eta_total=eta_total+eta_shock*p%shock_perp
endif
!
if (lresi_etava) then
if (lweyl_gauge) then
do i = 1,3; fres(:,i) = fres(:,i) - p%etava * p%jj(:,i); enddo;
endif
eta_total = eta_total + p%etava
endif
!
! Generalised Alfven speed dependent resistivity
!
if (lresi_vAspeed) then
if (lweyl_gauge) then
do i = 1,3; fres(:,i) = fres(:,i) - p%etava * p%jj(:,i); enddo;
else
do i=1,3
fres(:,i) = fres(:,i) + mu0 * p%etava * p%del2a(:,i) + eta_va/vArms * p%diva * p%gva(:,i)
enddo
endif
eta_total = eta_total + p%etava
endif
!
if (lresi_etaj) then
do i = 1,3; fres(:,i) = fres(:,i) - p%etaj * p%jj(:,i); enddo;
eta_total = eta_total + p%etaj
endif
!
if (lresi_etaj2) then
do i = 1,3; fres(:,i) = fres(:,i) - p%etaj2 * p%jj(:,i); enddo;
eta_total = eta_total + p%etaj2
endif
!
if (lresi_etajrho) then
do i = 1,3; fres(:,i) = fres(:,i) - p%etajrho * p%jj(:,i); enddo;
eta_total = eta_total + p%etajrho
endif
!
if (lresi_smagorinsky) then
if (.not.lweyl_gauge) then
if (letasmag_as_aux) then
eta_smag=(D_smag*dxmax)**2.*sqrt(p%j2)
call multsv(eta_smag+eta,p%del2a,fres)
call grad(f,ietasmag,geta)
!
do j=1,3
fres(:,j)=fres(:,j)+geta(:,j)*p%diva
enddo
!
else
!
! Term grad(eta_smag) divA not implemented with pencils!
!
eta_smag=(D_smag*dxmax)**2.*sqrt(p%j2)
call multsv(eta_smag+eta,p%del2a,fres)
!
endif
else
eta_smag=(D_smag*dxmax)**2.*sqrt(p%j2)
!
do j=1,3
fres(:,j)=fres(:,j)-eta_smag*mu0*p%jj(:,j)
enddo
!
endif
endif
!
if (lresi_smagorinsky_nusmag) then
eta_smag=Pm_smag1*p%nu_smag
call multsv(eta_smag+eta,p%del2a,fres)
!
call grad(f,inusmag,geta)
do j=1,3
fres(:,j)=fres(:,j)+Pm_smag1*geta(:,j)*p%diva
enddo
endif
!
if (lresi_smagorinsky_cross) then
sign_jo=1.
do i=1,nx
if (p%jo(i) < 0) sign_jo(i)=-1.
enddo
eta_smag=(D_smag*dxmax)**2.*sign_jo*sqrt(p%jo*sign_jo)
call multsv(eta_smag+eta,p%del2a,fres)
endif
if (((lresi_smagorinsky .or. lresi_smagorinsky_nusmag .or. lresi_smagorinsky_cross))) eta_total = eta_total + eta_smag
if ((lresi_smagorinsky .or. lresi_smagorinsky_nusmag .or. lresi_smagorinsky_cross)) eta_total = eta_total + eta_smag
!
! Anomalous resistivity. Sets in when the ion-electron drift speed is
! larger than some critical value.
!
if (lresi_anomalous) then
vdrift=sqrt(sum(p%jj**2,2))*p%rho1
if (lweyl_gauge) then
do i=1,3
if (eta_anom_thresh/=0) then
where (eta_anom*vdrift > eta_anom_thresh*vcrit_anom)
fres(:,i)=fres(:,i)-eta_anom_thresh*mu0*p%jj(:,i)
elsewhere
fres(:,i)=fres(:,i)-eta_anom*vdrift/vcrit_anom*mu0*p%jj(:,i)
endwhere
else
where (vdrift>vcrit_anom) fres(:,i)=fres(:,i)-eta_anom*vdrift/vcrit_anom*mu0*p%jj(:,i)
endif
enddo
else
call fatal_error('daa_dt','must have Weyl gauge for anomalous resistivity')
endif
if (eta_anom_thresh/=0) then
where (eta_anom*vdrift > eta_anom_thresh*vcrit_anom)
eta_total=eta_total+eta_anom_thresh
elsewhere
eta_total=eta_total+eta_anom*vdrift/vcrit_anom
endwhere
else
where (vdrift>vcrit_anom) eta_total=eta_total+eta_anom*vdrift/vcrit_anom
endif
endif
!
! Temperature dependent resistivity for the solar corona (Spitzer 1969)
!
if (lresi_spitzer) then
if (lweyl_gauge) then
do i=1,3
fres(:,i)=fres(:,i)-eta_spitzer*exp(-1.5*p%lnTT)*mu0*p%jj(:,i)
enddo
else
do i=1,3
fres(:,i)=fres(:,i)+eta_spitzer*exp(-1.5*p%lnTT)*(p%del2a(:,i)-1.5*p%diva*p%glnTT(:,i))
enddo
endif
eta_total = eta_total + eta_spitzer*exp(-1.5*p%lnTT)
endif
!
! Resistivity proportional to sound speed for stability of SN Turbulent ISM
! fred: 23.9.17 replaced 0.5 with eta_cspeed so exponent can be generalised
!
if (lresi_cspeed) then
if (lweyl_gauge) then
do i=1,3
fres(:,i)=fres(:,i)-eta*exp(eta_cspeed*p%lnTT)*mu0*p%jj(:,i)
enddo
else
do i=1,3
fres(:,i)=fres(:,i)+eta*exp(eta_cspeed*p%lnTT)*(p%del2a(:,i)+0.5*p%diva*p%glnTT(:,i))
enddo
endif
eta_total = eta_total + eta*exp(eta_cspeed*p%lnTT)
endif
!
! Resistivity proportional to vertical velocity
!
if (lresi_eta_proptouz) then
if (lweyl_gauge) then
do i=1,3
fres(:,i)=fres(:,i)-eta*ampl_eta_uz*p%uu(:,3)*mu0*p%jj(:,i)
enddo
else
do i=1,3
fres(:,i)=fres(:,i)+eta*ampl_eta_uz*(p%uu(:,3)*p%del2a(:,i)+p%uij(:,3,i)*p%diva)
enddo
endif
eta_total = eta_total + eta*ampl_eta_uz*p%uu(:,3)
endif
!
! Magnetic field dependent resistivity
!
if (lresi_magfield) then
eta_BB=eta/(1.+etaB*p%bb(:,2)**2)
if (lweyl_gauge) then
do i=1,3
fres(:,i)=fres(:,i)-mu0*eta_BB*p%jj(:,i)
enddo
endif
eta_total = eta_total + eta_BB
endif
!
! anisotropic B-dependent diffusivity
!
if (eta_aniso_BB/=0.0) then
where (p%b2==0.)
tmp1=0.
elsewhere
tmp1=eta_aniso_BB/p%b2
endwhere
if (lquench_eta_aniso) tmp1=tmp1/(1.+quench_aniso*Arms)
do j=1,3
df(l1:l2,m,n,iaa-1+j)=df(l1:l2,m,n,iaa-1+j)-tmp1*p%jb*p%bb(:,j)
enddo
eta_total = eta_total + eta_aniso_BB
endif
!
! Ambipolar diffusion in the strong coupling approximation.
!
if (lambipolar_diffusion) then
do j=1,3
df(l1:l2,m,n,iaa-1+j)=df(l1:l2,m,n,iaa-1+j)+p%nu_ni1*p%jxbrxb(:,j)
enddo
if (lentropy .and. lneutralion_heat) then
if (pretend_lnTT) then
df(l1:l2,m,n,iss) = df(l1:l2,m,n,iss) + p%cv1*p%TT1*p%nu_ni1*p%jxbr2
else
df(l1:l2,m,n,iss) = df(l1:l2,m,n,iss) + p%TT1*p%nu_ni1*p%jxbr2
endif
elseif (ltemperature .and. lneutralion_heat) then
df(l1:l2,m,n,ilnTT) = df(l1:l2,m,n,ilnTT) + p%cv1*p%TT1*p%nu_ni1*p%jxbr2
endif
eta_total = eta_total + p%nu_ni1*p%va2
endif
!
! Consider here the action of a mean friction term, -LLambda*Abar.
! Works only on one processor. Note that there is also the analogous case
! to Ekman friction; see below.
!
if (lmean_friction) then
call calc_aaxyaver(aa_xyaver,f)
dAdt = dAdt-LLambda_aa*aa_xyaver
elseif (llocal_friction) then
dAdt = dAdt-LLambda_aa*p%aa
endif
!
!SLD if (lmagnetic_slope_limited.and.llast) then
!SLD df(l1:l2,m,n,iax:iaz)=df(l1:l2,m,n,iax:iaz)-f(l1:l2,m,n,iFF_div_aa:iFF_div_aa+2)
!SLD if (lohmic_heat) then
!SLD call dot(f(l1:l2,m,n,iFF_div_aa:iFF_div_aa+2),p%jj,phi) !tb checked
!SLD df(l1:l2,m,n,iss)=df(l1:l2,m,n,iss)+(eta_total*mu0)*p%rho1*p%TT1*phi
! Slope limited diffusion for magnetic field
!
if (lmagnetic_slope_limited.and.llast) then
! if (lmagnetic_slope_limited) then
if (lsld_bb) then
!
! Using diffusive flux of B on A
! Idea: DA_i/dt = ... - e_ikl Dsld_k B_l
! where Dsld is the SLD operator
! normal way: DA_i/dt = ... partial_j Dsld_j A_l
!
do j=1,3
call calc_slope_diff_flux(f,ibx+(j-1),p,h_sld_magn,nlf_sld_magn,tmp1,div_sld_magn, &
FLUX1=d_sld_flux(:,1,j),FLUX2=d_sld_flux(:,2,j),FLUX3=d_sld_flux(:,3,j))
enddo
!
tmp2(:,1)= (-d_sld_flux(:,2,3) + d_sld_flux(:,3,2))*fac_sld_magn
tmp2(:,2)= (-d_sld_flux(:,3,1) + d_sld_flux(:,1,3))*fac_sld_magn
tmp2(:,3)= (-d_sld_flux(:,1,2) + d_sld_flux(:,2,1))*fac_sld_magn
!
fres=fres + tmp2
else
!
if (lcylindrical_coords .or. lspherical_coords) then
do j=1,3
call calc_slope_diff_flux(f,iax+(j-1),p,h_sld_magn,nlf_sld_magn,tmp2(:,j),div_sld_magn, &
FLUX1=d_sld_flux(:,1,j),FLUX2=d_sld_flux(:,2,j),FLUX3=d_sld_flux(:,3,j))
enddo
!
if (lcylindrical_coords) then
fres(:,1)=fres(:,1)+tmp2(:,1)-(d_sld_flux(:,2,2))/x(l1:l2)
fres(:,2)=fres(:,2)+tmp2(:,2)+(d_sld_flux(:,2,1))/x(l1:l2)
fres(:,3)=fres(:,3)+tmp2(:,3)
elseif(lspherical_coords) then
fres(:,1)=fres(:,1)+tmp2(:,1)-(d_sld_flux(:,2,2)+d_sld_flux(:,3,3))/x(l1:l2)
fres(:,2)=fres(:,2)+tmp2(:,2)+(d_sld_flux(:,2,1)-d_sld_flux(:,3,3)*cotth(m))/x(l1:l2)
fres(:,3)=fres(:,3)+tmp2(:,3)+(d_sld_flux(:,3,1)+d_sld_flux(:,3,2)*cotth(m))/x(l1:l2)
endif
else
do j=1,3
call calc_slope_diff_flux(f,iax+(j-1),p,h_sld_magn,nlf_sld_magn,tmp2(:,j),div_sld_magn)
enddo
fres=fres+tmp2
endif
endif
!
! Heating is jj*divF_sld
! or Heating is just jj*(-e_ijk Dsld_k B_l) (for lsld_bb=T)
!
if (lohmic_heat) then
call dot(tmp2,p%jj,tmp1)
if (lentropy) then
if (pretend_lnTT) then
df(l1:l2,m,n,iss) = df(l1:l2,m,n,iss) + p%cv1*max(0.0,tmp1)*p%rho1*p%TT1
else
df(l1:l2,m,n,iss) = df(l1:l2,m,n,iss) + max(0.0,tmp1)*p%rho1*p%TT1
endif
else if (ltemperature) then
if (ltemperature_nolog) then
df(l1:l2,m,n,iTT) = df(l1:l2,m,n,iTT) + p%cv1*max(0.0,tmp1)*p%rho1
else
df(l1:l2,m,n,ilnTT) = df(l1:l2,m,n,ilnTT) + p%cv1*max(0.0,tmp1)*p%rho1*p%TT1
endif
else if (lthermal_energy) then
df(l1:l2,m,n,ieth) = df(l1:l2,m,n,ieth) + max(0.0,tmp1)
endif
endif
endif
!
! Special contributions to this module are called here.
!
if (lspecial) call special_calc_magnetic(f,df,p)
!
! possibility to reduce ohmic heating near the boundary
! currently implemented only for a profile in z above a value no_ohmic_heat_z0
! with the width no_ohmic_heat_zwidth for reduction, width has to tbe negative.
! Note that eta_heat must not enter eta_total.
!
if (lno_ohmic_heat_bound_z.and.lohmic_heat) then
eta_heat=eta_total*cubic_step(z(n),no_ohmic_heat_z0,no_ohmic_heat_zwidth)
else
eta_heat=eta_total
endif
!
! Add Ohmic heat to entropy or temperature equation.
!
if (.not.lkinematic.and.lohmic_heat) then
if (lentropy) then
if (pretend_lnTT) then
df(l1:l2,m,n,iss) = df(l1:l2,m,n,iss) + p%cv1*eta_heat*mu0*p%j2*p%rho1*p%TT1
else
df(l1:l2,m,n,iss) = df(l1:l2,m,n,iss) + eta_heat*mu0*p%j2*p%rho1*p%TT1
endif
else if (ltemperature) then
if (ltemperature_nolog) then
df(l1:l2,m,n,iTT) = df(l1:l2,m,n,iTT) + p%cv1*eta_heat*mu0*p%j2*p%rho1
else
df(l1:l2,m,n,ilnTT) = df(l1:l2,m,n,ilnTT) + p%cv1*eta_heat*mu0*p%j2*p%rho1*p%TT1
endif
else if (lthermal_energy) then
df(l1:l2,m,n,ieth) = df(l1:l2,m,n,ieth) + eta_heat*mu0*p%j2
endif
endif
!
! Switch off diffusion in boundary slice if requested by boundconds.
!
! Only need to do this on bottommost (topmost) processors
! and in bottommost (topmost) pencils.
!
do j=1,3
if (lfrozen_bb_bot(j)) then
if(lfirst_proc_z.and.n==n1) fres(:,j)=0.
endif
if (lfrozen_bb_top(j)) then
if (llast_proc_z.and.n==n2) fres(:,j)=0.
endif
enddo
!
! Induction equation.
!
if (.not.lupw_aa) then
if (linduction) then
if (ladvective_gauge) then
!
! Take care of possibility of imposed field.
!
if (any(B_ext/=0.)) then
call cross(p%uu,B_ext,ujiaj)
else
if (lfargo_advection) then
ajiuj=0.
else
ujiaj=0.
endif
endif
!
! Calculate ujiaj (=aj uj;i) or ajiuj for fargo advection
!
do j=1,3
do k=1,3
if (lfargo_advection) then
ajiuj(:,j)=ajiuj(:,j)+p%uu(:,k)*p%aij(:,k,j)
else
ujiaj(:,j)=ujiaj(:,j)+p%aa(:,k)*p%uij(:,k,j)
endif
enddo
enddo
!
! Curvature terms on ujiaj
!
if (lcylindrical_coords) then
if (lfargo_advection) then
ajiuj(:,2) = ajiuj(:,2) + (p%aa(:,1)*p%uu(:,2) - p%aa(:,2)*p%uu(:,1))*rcyl_mn1
else
ujiaj(:,2) = ujiaj(:,2) + (p%uu(:,1)*p%aa(:,2) - p%uu(:,2)*p%aa(:,1))*rcyl_mn1
endif
!
else if (lspherical_coords) then
ujiaj(:,2) = ujiaj(:,2) + (p%uu(:,1)*p%aa(:,2) - p%uu(:,2)*p%aa(:,1))*r1_mn
ujiaj(:,3) = ujiaj(:,3) + (p%uu(:,1)*p%aa(:,3) - &
p%uu(:,3)*p%aa(:,1) + &
p%uu(:,2)*p%aa(:,3)*cotth(m) - &
p%uu(:,3)*p%aa(:,3)*cotth(m))*r1_mn
endif
!
if (.not.lfargo_advection) then
dAdt = dAdt-p%uga-ujiaj+fres
else
! the gauge above, with -ujiaj is unstable due to the buildup of the irrotational term
! Candelaresi et al. 2011. The gauge below does not have the irrotational term. On the
! other hand it cancels out the full advection term if fargo isn't used.
dAdt = dAdt-p%uuadvec_gaa+ajiuj+fres
endif
! df(l1:l2,m,n,iax:iaz)=df(l1:l2,m,n,iax:iaz)-p%uga-ujiaj+fres
!
! ladvective_gauge2
!
elseif (ladvective_gauge2) then
if (lua_as_aux) then
call grad(f,iua,gua)
dAdt = dAdt + p%uxb+fres-gua
else
call fatal_error('daa_dt','must put lua_as_aux=T for advective_gauge2')
endif
!
! ladvective_gauge=F, so just the normal uxb term plus resistive term.
!
else
!print*,'this, right?'
dAdt = dAdt+ p%uxb+fres
endif
!
!NS: added lnoinduction switch to suppress uxb term when needed
!
if (lnoinduction) then
!print*,'no induction'
dAdt = dAdt - p%uxb
endif
endif
else
!
! Use upwinding for the advection term.
!
! We only do upwinding for advection-like terms, u_i f_k,j,
! for which i=j. This means that for instance in the evolution
! equation for A_x,
!
! d(A_x)/dt + u_y A_x,y + u_z A_x,z = u_y A_y,x + u_z A_z,x
!
! we only do upwinding for the advection-type terms on the
! left hand side.
!
if (lupw_aa.and.headtt) print *,'daa_dt: use upwinding in advection term'
!
! Add Lorentz force that results from the external field.
! Note: For now, this only works for uniform external fields.
!
if (any(B_ext/=0.)) then
call cross(p%uu,B_ext,uxb_upw)
else
uxb_upw=0.
endif
!
! Add u_k A_k,j and `upwinded' advection term.
! Note: this works currently only in cartesian geometry!
!
if (ladvective_gauge) then
ujiaj=0.
do j=1,3
do k=1,3
ujiaj(:,j)=ujiaj(:,j)+p%aa(:,k)*p%uij(:,k,j)
enddo
uxb_upw(:,j)=uxb_upw(:,j)-p%uga(:,j)-ujiaj(:,j)
enddo
!
! ladvective_gauge=F, so just the normal uxb term plus resistive term.
!
else
do j=1,3
!
do k=1,3
if (k/=j) then
uxb_upw(:,j)=uxb_upw(:,j)+p%uu(:,k)*(p%aij(:,k,j)-p%aij(:,j,k))
endif
enddo
!
call doupwind(f,iaa+j-1,p%uu,uxb_upw(:,j),mask=j)
!
enddo
!
endif
!
! Full right hand side of the induction equation.
!
if (linduction) dAdt= dAdt + uxb_upw + fres
endif
!
! limp_alpha=T, add artificial z dependent alpha dynamo.
!
if(limp_alpha) then
if (abs(z(n))<=imp_halpha/2) then
dAdt = dAdt+imp_alpha0*sin(pi*z(n)/imp_halpha)*p%bb
else
dAdt = dAdt+sign(imp_alpha0,z(n))*exp(-((2*z(n)-sign(imp_halpha,z(n)))/imp_halpha)**2)*p%bb
endif
endif
!
! Add Hall term.
!
if (hall_term/=0.0) then
select case (ihall_term)
case ('const'); hall_term_=hall_term
case ('t-dep'); hall_term_=hall_term*max(real(t),hall_tdep_t0)**hall_tdep_exponent
case ('z-dep'); hall_term_=hall_term/(1.-(z(n)-xyz1(3))/Hhall)**hall_zdep_exponent
endselect
if (headtt) print*,'daa_dt: hall_term=',hall_term_
dAdt=dAdt-hall_term_*p%jxb
if (lupdate_courant_dt) then
advec_hall=sum(abs(p%uu-hall_term_*p%jj)*dline_1,2)
if (notanumber(advec_hall)) then
if (lproc_print) then
print*, 'daa_dt: advec_hall =',advec_hall
if (.not.allproc_print) lproc_print=.false.
endif
endif
advec2=advec2+advec_hall**2
if (headtt.or.ldebug) print*,'daa_dt: max(advec_hall) =', maxval(advec_hall)
endif
endif
!
! Add Battery term.
! corrected by Mikhail Modestov
!
if (battery_term/=0.0) then
if (headtt) print*,'daa_dt: battery_term=',battery_term
!--- call multsv_mn(p%rho2,p%fpres,baroclinic)
!AB: corrected by Patrick Adams
dAdt = dAdt-battery_term*p%fpres
if (headtt.or.ldebug) print*,'daa_dt: max(battery_term) =',&
!MR; corrected for the time being to fix the auto-test
! battery_term*maxval(baroclinic)
battery_term*maxval(p%fpres)
endif
!
! Add ambipolar diffusion in strong coupling approximation
!
if (lambipolar_strong_coupling.and.tauAD/=0.0) then
dAdt=dAdt+tauAD*p%jxbxb
eta_total = eta_total + tauAD*mu01*p%b2
endif
!
! Add jxb/(b^2\nu) magneto-frictional velocity to uxb term
! Note that this is similar to lambipolar_strong_coupling, but here
! there is a division by b^2.
!AB: Piyali, I think the mu01 should be removed
!
if (lmagneto_friction.and.(.not.lhydro).and.numag/=0.0) then
tmp1=mu01/(numag*(B0_magfric/unit_magnetic**2+p%b2))
do i=1,3
dAdt(:,i) = dAdt(:,i) + p%jxbxb(:,i)*tmp1
enddo
if (.not. linduction) dAdt = dAdt + fres
endif
!
! Possibility of adding extra diffusivity in some halo of given geometry.
! eta_out is now the diffusivity in the outer halo.
!
if (height_eta/=0.0) then
if (headtt) print*,'daa_dt: height_eta,eta_out,lhalox=',height_eta,eta_out,lhalox
if (lhalox) then
do ix=1,nx
tmp=(x(ix)/height_eta)**2
eta_out1=eta_out*(1.0-exp(-tmp**5/max(1.0-tmp,1.0e-5)))-eta
enddo
else
!eta_out1=eta_out*0.5*(1.-erfunc((z(n)-height_eta)/eta_zwidth))-eta
!AB: 2018-12-18 changed to produce change *above* height_eta.
eta_out1=(eta_out-eta)*.5*(1.+erfunc((z(n)-height_eta)/eta_zwidth))
endif
dAdt = dAdt-(eta_out1*mu0)*p%jj
eta_total = eta_total + eta_out1*mu0
endif
!
! Ekman Friction, used only in two dimensional runs.
!
if (ekman_friction_aa/=0) df(l1:l2,m,n,iax:iaz)=df(l1:l2,m,n,iax:iaz)-ekman_friction_aa*p%aa
!
! Add possibility of forcing that is not delta-correlated in time.
!
if (lforcing_cont_aa) dAdt=dAdt+ ampl_fcont_aa*p%fcont(:,:,iforcing_cont_aa)
!
! Add possibility of local forcing that is also not delta-correlated in time.
!
if (lforcing_cont_aa_local) call forcing_continuous(df,p)
!
! Possibility of relaxation of A in exterior region.
!
if (tau_aa_exterior/=0.0) call calc_tau_aa_exterior(f,df)
!
! Relaxing A towards a given profile A_0 on a timescale tau_relprof,
! note that tau_relprof*u_rms*kf>>1 for this relaxation to affect only the mean fields.
!
if (tau_relprof/=0.0) then
! dAdt= dAdt-(p%aa-A_relprof(:,m,n,:))*tau_relprof1
! Piyali: The above is not right as dimension of A_relprof(nx,ny,nz,3),
! so m,n indices should be the following:
!
if (lA_relprof_global) then
!
! use the directly the global external vector potential
!
dAdt = dAdt-(p%aa-f(l1:l2,m,n,iglobal_ax_ext:iglobal_az_ext))*tau_relprof1
else
!dAdt= dAdt-(p%aa-A_relprof(:,m-m1+1,n-n1+1,:))*tau_relprof1
if (lrelaxprof_glob_scaled) then
dAdt = dAdt-(p%aa-amp_relprof*f(l1:l2,m,n,iglobal_ax_ext:iglobal_az_ext))*tau_relprof1
else
dAdt = dAdt-(p%aa-A_relprof(n-nghost,1))*tau_relprof1
endif
endif
endif
!
! Apply border profiles.
!
if (lborder_profiles) call set_border_magnetic(f,df,p)
!
! Option to constrain timestep for large forces and heat sources to include
! Lorentz force and Ohmic heating terms
! should set in entropy lthdiff_Hmax=F and lrhs_max=F & in hydro lcdt_tauf=F as handled here
!
if (lupdate_courant_dt.and.lrhs_max) then
if (lhydro) then
do j =1,3
where (abs(p%uu(:,j))>1) !MR: What is the significance of unity in this criterion?
uu1(:,j)=1./p%uu(:,j)
elsewhere
uu1(:,j)=1.
endwhere
enddo
endif
do j =1,3
where (abs(p%aa(:,j))>1)
aa1(:,j)=1./p%aa(:,j)
elsewhere
aa1(:,j)=1.
endwhere
enddo
do j=1,3
dAtot=abs(dAdt(:,j)*aa1(:,j))
dt1_max=max(dt1_max,dAtot/cdtf)
dAmax=max(dAmax,dAtot/cdtf)
if (lhydro) then
ftot=abs(df(l1:l2,m,n,iux+j-1)*uu1(:,j))
dt1_max=max(dt1_max,ftot/cdtf)
Fmax=max(Fmax,ftot/cdtf)
endif
enddo
if (lentropy) then
ssmax = max(ssmax,abs(df(l1:l2,m,n,iss))*p%cv1/cdts)
dt1_max=max(dt1_max,ssmax)
endif
endif
!
! Electric field E = -dA/dt, store the Electric field in f-array if asked for.
! This line must not be used when the displacement current is being solved for.
! But it might actually work correctly.
!
if (lee_as_aux) then
if (lroot) print*,'f(l1:l2,m,n,iex:iez)=-dAdt is set'
f(l1:l2,m,n,iex:iez)=-dAdt
endif
!
! Magnetic field in spherical coordinates from a Cartesian simulation
! for sphere-in-a-box setups
!
if (lbb_sph_as_aux.and.lsphere_in_a_box) then
f(l1:l2,m,n,ibb_sphr) = p%bb(:,1)*p%evr(:,1)+p%bb(:,2)*p%evr(:,2)+p%bb(:,3)*p%evr(:,3)
f(l1:l2,m,n,ibb_spht) = p%bb(:,1)*p%evth(:,1)+p%bb(:,2)*p%evth(:,2)+p%bb(:,3)*p%evth(:,3)
f(l1:l2,m,n,ibb_sphp) = p%bb(:,1)*p%phix+p%bb(:,2)*p%phiy
endif
!
! Hubble parameter (doesn't look generic)
!
if (lhubble_magnetic) then
dAdt = dAdt - 2.*Hubble*ascale**1.5*p%AA
call fatal_error('daa_dt','setting lhubble_hydro=T is not correct')
endif
!
! Now add all the contribution to dAdt so far into df.
! This is done here, such that contribution from mean-field models are not added to
! the electric field. This may need review later.
! All this is not executed when the displacement current is being computed.
! Ideally, we would like this dAdt to be equal to -p%el, if the displacement
! current is not being advanced. It should therefore be turned into a pencil.
! But we could use dAdt here for diagnostics.
!
df(l1:l2,m,n,iax:iaz)=df(l1:l2,m,n,iax:iaz)+dAdt
!
! Call right-hand side for mean-field stuff (do this just before ldiagnos)
!
if (lmagn_mf) call daa_dt_meanfield(f,df,p)
!
! Multiply resistivity by Nyquist scale, for resistive time-step.
!
if (lupdate_courant_dt) then
!
diffus_eta =eta_total *dxyz_2
diffus_eta2=diffus_eta2*dxyz_4
!
if (ldynamical_diffusion .and. lresi_hyper3_mesh) then
diffus_eta3 = diffus_eta3 * sum(dline_1,2)
else
diffus_eta3 = diffus_eta3*dxyz_6
endif
if (lpole(2) .and. lcoarse) then
if (lfirst_proc_y .and. m<m1+1.5*ncoarse .and. m>=m1) then
nphi = max(mod(int(ncoarse/(m-m1+1)),ncoarse+1),1)
elseif (llast_proc_y .and. m>m2-1.5*ncoarse .and. m<=m2) then
nphi = max(mod(int(ncoarse/(m2-m+1)),ncoarse+1),1)
else
nphi = 1
endif
!if (lroot .and. n==n1) print*,'fred: nphi, m',nphi, m
diffus_eta =diffus_eta /nphi**2
diffus_eta2=diffus_eta2/nphi**4
!
if (.not.(ldynamical_diffusion .and. lresi_hyper3_mesh)) diffus_eta3 = diffus_eta3/nphi**6
endif
!
if (headtt.or.ldebug) then
print*, 'daa_dt: max(diffus_eta) =', maxval(diffus_eta)
print*, 'daa_dt: max(diffus_eta2) =', maxval(diffus_eta2)
print*, 'daa_dt: max(diffus_eta3) =', maxval(diffus_eta3)
endif
maxdiffus=max(maxdiffus,diffus_eta)
maxdiffus2=max(maxdiffus2,diffus_eta2)
maxdiffus3=max(maxdiffus3,diffus_eta3)
!
endif
!
! This is the endif from (iex==0.or.loverride_ee)
!
endif
!
! Evolve current density.
!
if (lresi_eta_tdep .or. lresi_eta_xtdep .or. eta/=0.) then
if (lohm_evolve) then
print*,'AXEL2: should not be here (eta) ... '
if (tau_jj>0) then
tau1_jj=1./tau_jj
do j=1,3
!
! Here we would need to add tau*sigmaB*B
!
dJdt(:,j)=tau1_jj*(p%el(:,j)+p%uxb(:,j))*mu01/eta_total
enddo
if (ell_jj/=0.) then
call del2v(f,ijx,del2jj)
dJdt=dJdt+(ell_jj**2*tau1_jj)*del2jj
endif
df(l1:l2,m,n,ijx:ijz)=df(l1:l2,m,n,ijx:ijz)+dJdt
else
call fatal_error('daa_dt','tau_jj must be finite and positive')
endif
endif
endif
!
! Do diagnostics, which includes also slices.
!
call calc_diagnostics_magnetic(f,p)
!
! Debug output.
!
if (headtt .and. ip<=4) then
call output_pencil('aa.dat',p%aa,3)
call output_pencil('bb.dat',p%bb,3)
call output_pencil('jj.dat',p%jj,3)
call output_pencil('del2A.dat',p%del2a,3)
call output_pencil('JxBr.dat',p%jxbr,3)
call output_pencil('JxB.dat',p%jxb,3)
call output_pencil('df.dat',df(l1:l2,m,n,:),mvar)
endif
!
! Timing of this subroutine.
!
call timing('daa_dt','finished',mnloop=.true.)
!
endsubroutine daa_dt
!******************************************************************************
subroutine calc_diagnostics_magnetic(f,p)
use Diagnostics, only: save_name_sound
use Slices_methods, only: store_slices
use Sub, only: cross
real, dimension(:,:,:,:) :: f
type(pencil_case) :: p
integer :: isound,lspoint,mspoint,nspoint,j
real, dimension (nx,3) :: uxbxb,poynting
!
! Magnetic field components at the list of points written out in sound.dat
! lwrite_sound is false if either no sound output is required, or if none of
! the desired sound output location occur in the subdomain in this processor.
!
if (lwrite_sound.and.lout_sound) then
!
! go through the list of lpoints and mpoints
!
do isound=1,ncoords_sound
!
lspoint=sound_coords_list(isound,1)
mspoint=sound_coords_list(isound,2)
nspoint=sound_coords_list(isound,3)
!
if ((m==mspoint).and.(n==nspoint)) then
call save_name_sound(f(lspoint,mspoint,nspoint,iax),idiag_axpt,isound)
call save_name_sound(f(lspoint,mspoint,nspoint,iay),idiag_aypt,isound)
call save_name_sound(f(lspoint,mspoint,nspoint,iaz),idiag_azpt,isound)
call save_name_sound(p%bb(lspoint-nghost,1),idiag_bxpt,isound)
call save_name_sound(p%bb(lspoint-nghost,2),idiag_bypt,isound)
call save_name_sound(p%bb(lspoint-nghost,3),idiag_bzpt,isound)
if (idiag_bxbypt/=0) call save_name_sound(p%bb(lspoint-nghost,1)*p%bb(lspoint-nghost,2),idiag_bxbypt,isound)
if (idiag_bybzpt/=0) call save_name_sound(p%bb(lspoint-nghost,2)*p%bb(lspoint-nghost,3),idiag_bybzpt,isound)
if (idiag_bzbxpt/=0) call save_name_sound(p%bb(lspoint-nghost,3)*p%bb(lspoint-nghost,1),idiag_bzbxpt,isound)
call save_name_sound(p%jj(lspoint-nghost,1),idiag_jxpt,isound)
call save_name_sound(p%jj(lspoint-nghost,2),idiag_jypt,isound)
call save_name_sound(p%jj(lspoint-nghost,3),idiag_jzpt,isound)
call save_name_sound(p%uxbb(lspoint-nghost,1),idiag_Expt,isound)
call save_name_sound(p%uxbb(lspoint-nghost,2),idiag_Eypt,isound)
call save_name_sound(p%uxbb(lspoint-nghost,3),idiag_Ezpt,isound)
endif
enddo
endif
call calc_2d_diagnostics_magnetic(p)
call calc_1d_diagnostics_magnetic(p)
if (ldiagnos) call calc_0d_diagnostics_magnetic(f,p)
!
! Write B-slices for output in wvid in run.f90.
! Note: ix_loc is the index with respect to array with ghost zones.
!
if (lvideo.and.lfirst) then
!
if (ivid_aps/=0) call store_slices(p%aps,aps_xy,aps_xz,aps_yz,xz2=aps_xz2)
if (ivid_bb/=0) call store_slices(p%bb,bb_xy,bb_xz,bb_yz,bb_xy2,bb_xy3,bb_xy4,bb_xz2,bb_r)
if (ivid_jj/=0) call store_slices(p%jj,jj_xy,jj_xz,jj_yz,jj_xy2,jj_xy3,jj_xy4,jj_xz2,jj_r)
if (ivid_b2/=0) call store_slices(p%b2,b2_xy,b2_xz,b2_yz,b2_xy2,b2_xy3,b2_xy4,b2_xz2,b2_r)
if (ivid_j2/=0) call store_slices(p%j2,j2_xy,j2_xz,j2_yz,j2_xy2,j2_xy3,j2_xy4,j2_xz2,j2_r)
if (ivid_bb_sph/=0) call store_slices(p%bb_sph,bb_sph_xy,bb_sph_xz,bb_sph_yz, &
bb_sph_xy2,bb_sph_xy3,bb_sph_xy4,bb_sph_xz2,bb_sph_r)
if (ivid_jb/=0) call store_slices(p%jb,jb_xy,jb_xz,jb_yz,jb_xy2,jb_xy3,jb_xy4,jb_xz2,jb_r)
if (ivid_ab/=0) call store_slices(p%ab,ab_xy,ab_xz,ab_yz,ab_xy2,ab_xy3,ab_xy4,ab_xz2,ab_r)
if (ivid_beta1/=0) call store_slices(p%beta1,beta1_xy,beta1_xz,beta1_yz,beta1_xy2, &
beta1_xy3,beta1_xy4,beta1_xz2,beta1_r)
if (ivid_poynting/=0) then
call cross(p%uxb,p%bb,uxbxb)
do j=1,3
poynting(:,j) = eta_total*p%jxb(:,j) - mu01*uxbxb(:,j)
enddo
call store_slices(poynting,poynting_xy,poynting_xz,poynting_yz, &
poynting_xy2,poynting_xy3,poynting_xy4,poynting_xz2,poynting_r)
endif
!
endif
call calc_diagnostics_meanfield(f,p)
endsubroutine calc_diagnostics_magnetic
!******************************************************************************
subroutine calc_0d_diagnostics_magnetic(f,p)
!
! Calculate diagnostic quantities.
!
use Diagnostics
use Sub, only: dot, dot2, multvs, cross_mn, multmv_transp, dot2_mn, &
cross_mn, dot_mn, dot2_mn, dot_mn_sv, dot_mn_vm_trans, grad, &
multsm_mn, multvv_smat_add, multm2_mn, mult_mat_vv,vecout
real, dimension(:,:,:,:) :: f
type(pencil_case) :: p
real, dimension (nx,3,3) :: bhatij
real, dimension (nx,3) :: exj, dexb, phib, jxbb, uxDxuxb, tmpv
real, dimension (nx) :: uxj_dotB0,b3b21,b3b12,b1b32,b1b23,b2b13,b2b31
real, dimension (nx) :: jxb_dotB0,jxbrq,uxb_dotB0, gLama, gLamb
real, dimension (nx) :: oxuxb_dotB0,jxbxb_dotB0,uxDxuxb_dotB0
real, dimension (nx) :: aj, tmp, tmp1, fres2
real, dimension (nx) :: B1dot_glnrhoxb,fb,fxbx
real, dimension (nx) :: b2t,bjt,jbt,ubt,but,ujt,jut
real, dimension (nx) :: phi,dub,dob,jdel2a,epsAD
real, dimension (nx) :: rmask, quench
call sum_mn_name(p%beta1,idiag_beta1m)
call max_mn_name(p%beta1,idiag_beta1max)
call sum_mn_name(p%beta, idiag_betam)
call max_mn_name(p%beta, idiag_betamax)
if (idiag_betamin /= 0) call max_mn_name(-p%beta, idiag_betamin, lneg=.true.)
if (idiag_Azmid_min /= 0) call max_mn_name(-p%aa(:,3)*xmask1_mag, idiag_Azmid_min, lneg=.true.)
call max_mn_name( p%aa(:,3),idiag_Azmid_max)
if (.not.lmultithread) then
!
! These diagnostics rely upon mn-dependent quantities which are not in the pencil case.
!
if (lrhs_max) then
call max_mn_name(ssmax,idiag_dtHr,l_dt=.true.)
call max_mn_name(Fmax,idiag_dtFr,l_dt=.true.)
call max_mn_name(dAmax,idiag_dtBr,l_dt=.true.)
endif
if (idiag_Bresrms/=0 .or. idiag_Rmrms/=0) then
call dot2_mn(fres,fres2)
call sum_mn_name(fres2,idiag_Bresrms,lsqrt=.true.)
if (idiag_Rmrms/=0) call sum_mn_name(p%uxb2/fres2,idiag_Rmrms,lsqrt=.true.)
endif
endif
!
! Integrate velocity in time, to calculate correlation time later.
!
if (idiag_b2tm/=0) then
call dot(p%bb,f(l1:l2,m,n,ibxt:ibzt),b2t)
call sum_mn_name(b2t,idiag_b2tm)
endif
!
! Integrate velocity in time, to calculate correlation time later.
!
if (idiag_jbtm/=0) then
call dot(p%jj,f(l1:l2,m,n,ibxt:ibzt),jbt)
call sum_mn_name(jbt,idiag_jbtm)
endif
!
! Integrate velocity in time, to calculate correlation time later.
!
if (idiag_bjtm/=0) then
call dot(p%bb,f(l1:l2,m,n,ijxt:ijzt),bjt)
call sum_mn_name(bjt,idiag_bjtm)
endif
!
! Integrate velocity in time, to calculate correlation time later.
!
if (idiag_jutm/=0) then
call dot(p%jj,f(l1:l2,m,n,iuxt:iuzt),jut)
call sum_mn_name(jut,idiag_jutm)
endif
!
! Integrate velocity in time, to calculate correlation time later.
!
if (idiag_ujtm/=0) then
call dot(p%uu,f(l1:l2,m,n,ijxt:ijzt),ujt)
call sum_mn_name(ujt,idiag_ujtm)
endif
!
! Integrate velocity in time, to calculate correlation time later.
!
if (idiag_butm/=0) then
call dot(p%bb,f(l1:l2,m,n,iuxt:iuzt),but)
call sum_mn_name(but,idiag_butm)
endif
!
! Integrate velocity in time, to calculate correlation time later.
!
if (idiag_ubtm/=0) then
call dot(p%uu,f(l1:l2,m,n,ibxt:ibzt),ubt)
call sum_mn_name(ubt,idiag_ubtm)
endif
!
! Contributions to vertical Poynting vector. Consider them here
! separately, because the contribution b^2*uz may be a good indicator
! of magnetic buoyancy.
!
if (idiag_b2ruzm/=0) call sum_mn_name(p%b2*p%rho*p%uu(:,3),idiag_b2ruzm)
if (idiag_b2uzm/=0) call sum_mn_name(p%b2*p%uu(:,3),idiag_b2uzm)
if (idiag_ubbzm/=0) call sum_mn_name(p%ub*p%bb(:,3),idiag_ubbzm)
!
! Mean squared and maximum squared magnetic field.
!
if (idiag_b1m/=0) call sum_mn_name(sqrt(p%b2),idiag_b1m)
call sum_mn_name(p%b2,idiag_b2m)
if (idiag_EEM/=0) call sum_mn_name(.5*p%b2,idiag_EEM)
if (idiag_EEM2/=0) call sum_mn_name((.5*p%b2)**2,idiag_EEM2)
if (idiag_EEM3/=0) call sum_mn_name((.5*p%b2)**3,idiag_EEM3)
if (idiag_EEM4/=0) call sum_mn_name((.5*p%b2)**4,idiag_EEM4)
if (idiag_b4m/=0) call sum_mn_name(p%b2**2,idiag_b4m,llog10=.true.)
if (idiag_b6m/=0) call sum_mn_name(p%b2**3,idiag_b6m,llog10=.true.)
if (idiag_b12m/=0) call sum_mn_name(p%b2**6,idiag_b12m,llog10=.true.)
call max_mn_name(p%b2,idiag_bm2)
call sum_mn_name(p%b2,idiag_brms,lsqrt=.true.)
call sum_mn_name(p%bf2,idiag_bfrms,lsqrt=.true.)
call sum_mn_name(p%bf2,idiag_bf2m)
if (idiag_bf4m/=0) call sum_mn_name(p%bf2**2,idiag_bf4m)
if (idiag_emag/=0) call integrate_mn_name(mu012*p%b2,idiag_emag)
if (idiag_brmsh/=0) then
if (lequatory) call sum_mn_name_halfy(p%b2,idiag_brmsh)
if (lequatorz) call sum_mn_name_halfz(p%b2,idiag_brmsh)
fname(idiag_brmsn)=fname_half(idiag_brmsh,1)
fname(idiag_brmss)=fname_half(idiag_brmsh,2)
itype_name(idiag_brmsn)=ilabel_sum_sqrt
itype_name(idiag_brmss)=ilabel_sum_sqrt
endif
if (idiag_brmsx/=0) call sum_mn_name(p%b2*xmask_mag,idiag_brmsx,lsqrt=.true.)
if (idiag_brmsz/=0) call sum_mn_name(p%b2*zmask_mag(n-n1+1),idiag_brmsz,lsqrt=.true.)
call max_mn_name(p%b2,idiag_bmax,lsqrt=.true.)
if (idiag_bxmin/=0) call max_mn_name(-p%bb(:,1),idiag_bxmin,lneg=.true.)
if (idiag_bymin/=0) call max_mn_name(-p%bb(:,2),idiag_bymin,lneg=.true.)
if (idiag_bzmin/=0) call max_mn_name(-p%bb(:,3),idiag_bzmin,lneg=.true.)
call max_mn_name(p%bb(:,1),idiag_bxmax)
call max_mn_name(p%bb(:,2),idiag_bymax)
call max_mn_name(p%bb(:,3),idiag_bzmax)
call max_mn_name(abs(p%bbb(:,1)),idiag_bbxmax)
call max_mn_name(abs(p%bbb(:,2)),idiag_bbymax)
call max_mn_name(abs(p%bbb(:,3)),idiag_bbzmax)
call max_mn_name(abs(p%jj(:,1)),idiag_jxmax)
call max_mn_name(abs(p%jj(:,2)),idiag_jymax)
call max_mn_name(abs(p%jj(:,3)),idiag_jzmax)
if (idiag_aybym2/=0) call sum_mn_name(2.*p%aa(:,2)*p%bb(:,2),idiag_aybym2)
call sum_mn_name(p%ab,idiag_abm)
if (idiag_gLamam/=0) then
call dot(p%gLam,p%aa,gLama)
call sum_mn_name(gLama,idiag_gLamam)
endif
if (idiag_gLambm/=0) then
if (iLam/=0) then
call dot(p%gLam,p%bb,gLamb)
call sum_mn_name(gLamb,idiag_gLambm)
else
call fatal_error('calc_0d_diagnostics_magnetic', 'Coulomb gauge is needed')
endif
endif
if (idiag_a2b2m/=0) call sum_mn_name(p%a2*p%b2,idiag_a2b2m)
if (idiag_j2b2m/=0) call sum_mn_name(p%j2*p%b2,idiag_j2b2m)
if (idiag_abumx/=0) call sum_mn_name(p%uu(:,1)*p%ab,idiag_abumx)
if (idiag_abumy/=0) call sum_mn_name(p%uu(:,2)*p%ab,idiag_abumy)
if (idiag_abumz/=0) call sum_mn_name(p%uu(:,3)*p%ab,idiag_abumz)
if (idiag_abrms/=0) call sum_mn_name(p%ab**2,idiag_abrms,lsqrt=.true.)
if (idiag_jbrms/=0) call sum_mn_name(p%jb**2,idiag_jbrms,lsqrt=.true.)
if (idiag_jxbrms/=0) then
call dot2(p%jxb,tmp)
call sum_mn_name(tmp,idiag_jxbrms,lsqrt=.true.)
endif
if (idiag_b2sphm/=0) then
where (p%r_mn <= radius_diag)
rmask = 1.
elsewhere
rmask = 0.
endwhere
call integrate_mn_name(rmask*p%b2,idiag_b2sphm)
endif
!
! Hemispheric magnetic helicity of total field.
! North means 1 and south means 2.
!
if (idiag_abmh/=0) then
if (lequatory) call sum_mn_name_halfy(p%ab,idiag_abmh)
if (lequatorz) call sum_mn_name_halfz(p%ab,idiag_abmh)
fname(idiag_abmn)=fname_half(idiag_abmh,1)
fname(idiag_abms)=fname_half(idiag_abmh,2)
itype_name(idiag_abmn)=ilabel_sum
itype_name(idiag_abms)=ilabel_sum
endif
!
! Hemispheric current helicity of total field.
! North means 1 and south means 2.
!
if (idiag_jbmh/=0) then
if (lequatory) call sum_mn_name_halfy(p%jb,idiag_jbmh)
if (lequatorz) call sum_mn_name_halfz(p%jb,idiag_jbmh)
fname(idiag_jbmn)=fname_half(idiag_jbmh,1)
fname(idiag_jbms)=fname_half(idiag_jbmh,2)
itype_name(idiag_jbmn)=ilabel_sum
itype_name(idiag_jbms)=ilabel_sum
endif
!
! Mean dot product of forcing and magnetic field, <f.b>.
!
if (idiag_fbm/=0) then
call dot(p%fcont(:,:,iforcing_cont_aa),p%bb,fb)
call sum_mn_name(fb,idiag_fbm)
endif
!
! if (lpenc_loc(i_rho1gpp)) then
! call fatal_error('calc_pencils_eos','rho1gpp not available 2')
! endif
!
! Give zero if there is no magnetic forcing
!
if (idiag_fxbxm/=0) then
if (iforcing_cont_aa>0) then
fxbx=p%fcont(:,1,iforcing_cont_aa)*p%bb(:,1)
call sum_mn_name(fxbx,idiag_fxbxm)
endif
endif
!
! Cross helicity (linkage between vortex tubes and flux tubes).
!
call sum_mn_name(p%ub,idiag_ubm)
if (idiag_uxbxm/=0) call sum_mn_name(p%uu(:,1)*p%bb(:,1),idiag_uxbxm)
if (idiag_uybxm/=0) call sum_mn_name(p%uu(:,2)*p%bb(:,1),idiag_uybxm)
if (idiag_uzbxm/=0) call sum_mn_name(p%uu(:,3)*p%bb(:,1),idiag_uzbxm)
if (idiag_uxbym/=0) call sum_mn_name(p%uu(:,1)*p%bb(:,2),idiag_uxbym)
if (idiag_uybym/=0) call sum_mn_name(p%uu(:,2)*p%bb(:,2),idiag_uybym)
if (idiag_uzbym/=0) call sum_mn_name(p%uu(:,3)*p%bb(:,2),idiag_uzbym)
if (idiag_uxbzm/=0) call sum_mn_name(p%uu(:,1)*p%bb(:,3),idiag_uxbzm)
if (idiag_uybzm/=0) call sum_mn_name(p%uu(:,2)*p%bb(:,3),idiag_uybzm)
if (idiag_uzbzm/=0) call sum_mn_name(p%uu(:,3)*p%bb(:,3),idiag_uzbzm)
call sum_mn_name(p%cosub,idiag_cosubm)
!
! Current helicity tensor (components)
!
!if (idiag_jbm/=0) call sum_mn_name(p%ub,idiag_ubm)
if (idiag_jxbxm/=0) call sum_mn_name(p%jj(:,1)*p%bb(:,1),idiag_jxbxm)
if (idiag_jybxm/=0) call sum_mn_name(p%jj(:,2)*p%bb(:,1),idiag_jybxm)
if (idiag_jzbxm/=0) call sum_mn_name(p%jj(:,3)*p%bb(:,1),idiag_jzbxm)
if (idiag_jxbym/=0) call sum_mn_name(p%jj(:,1)*p%bb(:,2),idiag_jxbym)
if (idiag_jybym/=0) call sum_mn_name(p%jj(:,2)*p%bb(:,2),idiag_jybym)
if (idiag_jzbym/=0) call sum_mn_name(p%jj(:,3)*p%bb(:,2),idiag_jzbym)
if (idiag_jxbzm/=0) call sum_mn_name(p%jj(:,1)*p%bb(:,3),idiag_jxbzm)
if (idiag_jybzm/=0) call sum_mn_name(p%jj(:,2)*p%bb(:,3),idiag_jybzm)
if (idiag_jzbzm/=0) call sum_mn_name(p%jj(:,3)*p%bb(:,3),idiag_jzbzm)
!
! Velocity-current density tensor (components)
!
if (idiag_uxjxm/=0) call sum_mn_name(p%uu(:,1)*p%jj(:,1),idiag_uxjxm)
if (idiag_uxjym/=0) call sum_mn_name(p%uu(:,1)*p%jj(:,2),idiag_uxjym)
if (idiag_uxjzm/=0) call sum_mn_name(p%uu(:,1)*p%jj(:,3),idiag_uxjzm)
if (idiag_uyjxm/=0) call sum_mn_name(p%uu(:,2)*p%jj(:,1),idiag_uyjxm)
if (idiag_uyjym/=0) call sum_mn_name(p%uu(:,2)*p%jj(:,2),idiag_uyjym)
if (idiag_uyjzm/=0) call sum_mn_name(p%uu(:,2)*p%jj(:,3),idiag_uyjzm)
if (idiag_uzjxm/=0) call sum_mn_name(p%uu(:,3)*p%jj(:,1),idiag_uzjxm)
if (idiag_uzjym/=0) call sum_mn_name(p%uu(:,3)*p%jj(:,2),idiag_uzjym)
if (idiag_uzjzm/=0) call sum_mn_name(p%uu(:,3)*p%jj(:,3),idiag_uzjzm)
!
! compute rms value of difference between u and b !!!MR: units?
!
if (idiag_dubrms/=0) then
call dot2(p%uu-p%bb,dub)
call sum_mn_name(dub,idiag_dubrms,lsqrt=.true.)
endif
!
! compute rms value of difference between vorticity and b !!!MR: units?
!
if (idiag_dobrms/=0) then
call dot2(p%oo-p%bb,dob)
call sum_mn_name(dob,idiag_dobrms,lsqrt=.true.)
endif
!
! Field-velocity cross helicity (linkage between velocity and magnetic tubes).
!
call sum_mn_name(p%ua,idiag_uam)
!
! Current-vortex cross helicity (linkage between flow and magnetic flux tubes).
!
call sum_mn_name(p%ob,idiag_obm)
!
! Current-vortex cross helicity (linkage between vortex and current tubes).
!
call sum_mn_name(p%uj,idiag_ujm)
!
! Mean field <B_i>, and mean components of the correlation matrix <B_i B_j>.
! Note that this quantity does not include any imposed field!
!
call sum_mn_name(p%jj(:,1),idiag_jxm)
call sum_mn_name(p%jj(:,2),idiag_jym)
call sum_mn_name(p%jj(:,3),idiag_jzm)
call sum_mn_name(p%bbb(:,1),idiag_bxm)
call sum_mn_name(p%bbb(:,2),idiag_bym)
call sum_mn_name(p%bbb(:,3),idiag_bzm)
if (idiag_bx2m/=0) call sum_mn_name(p%bbb(:,1)**2,idiag_bx2m)
if (idiag_by2m/=0) call sum_mn_name(p%bbb(:,2)**2,idiag_by2m)
if (idiag_bz2m/=0) call sum_mn_name(p%bbb(:,3)**2,idiag_bz2m)
if (idiag_bx3m/=0) call sum_mn_name(p%bbb(:,1)**3,idiag_bx3m)
if (idiag_by3m/=0) call sum_mn_name(p%bbb(:,2)**3,idiag_by3m)
if (idiag_bz3m/=0) call sum_mn_name(p%bbb(:,3)**3,idiag_bz3m)
if (idiag_bx4m/=0) call sum_mn_name(p%bbb(:,1)**4,idiag_bx4m)
if (idiag_by4m/=0) call sum_mn_name(p%bbb(:,2)**4,idiag_by4m)
if (idiag_bz4m/=0) call sum_mn_name(p%bbb(:,3)**4,idiag_bz4m)
if (idiag_jx2m/=0) call sum_mn_name(p%jj(:,1)**2,idiag_jx2m)
if (idiag_jy2m/=0) call sum_mn_name(p%jj(:,2)**2,idiag_jy2m)
if (idiag_jz2m/=0) call sum_mn_name(p%jj(:,3)**2,idiag_jz2m)
if (idiag_jx4m/=0) call sum_mn_name(p%jj(:,1)**4,idiag_jx4m)
if (idiag_jy4m/=0) call sum_mn_name(p%jj(:,2)**4,idiag_jy4m)
if (idiag_jz4m/=0) call sum_mn_name(p%jj(:,3)**4,idiag_jz4m)
if (idiag_bxbym/=0) call sum_mn_name(p%bbb(:,1)*p%bbb(:,2),idiag_bxbym)
if (idiag_bxbzm/=0) call sum_mn_name(p%bbb(:,1)*p%bbb(:,3),idiag_bxbzm)
if (idiag_bybzm/=0) call sum_mn_name(p%bbb(:,2)*p%bbb(:,3),idiag_bybzm)
if (idiag_jh2m1/=0) call sum_mn_name(p%bij(:,2,3)**2+p%bij(:,1,3)**2,idiag_jh2m1)
if (idiag_jx2m1/=0) call sum_mn_name(p%bij(:,2,3)**2,idiag_jx2m1)
if (idiag_jy2m1/=0) call sum_mn_name(p%bij(:,1,3)**2,idiag_jy2m1)
if (idiag_jx2m2/=0) call sum_mn_name(p%bij(:,3,2)**2,idiag_jx2m2)
if (idiag_jy2m2/=0) call sum_mn_name(p%bij(:,3,1)**2,idiag_jy2m2)
if (idiag_jx2m3/=0) call sum_mn_name(-2.*p%bij(:,3,2)*p%bij(:,2,3),idiag_jx2m3)
if (idiag_jy2m3/=0) call sum_mn_name(-2.*p%bij(:,3,1)*p%bij(:,1,3),idiag_jy2m3)
call sum_mn_name(p%djuidjbi,idiag_djuidjbim)
!
! Calculate B*sin(phi) = -<Bx*sinkz> + <By*coskz>.
!
if (idiag_bsinphz/=0) call sum_mn_name(-p%bbb(:,1)*sinkz(n)+p%bbb(:,2)*coskz(n),idiag_bsinphz)
!
! Calculate B*cos(phi) = <Bx*coskz> + <By*sinkz>.
!
if (idiag_bcosphz/=0) call sum_mn_name(+p%bbb(:,1)*coskz(n)+p%bbb(:,2)*sinkz(n),idiag_bcosphz)
!
! v_A = |B|/sqrt(rho); in units where mu_0=1
!
call sum_mn_name(p%va2,idiag_vA2m)
if (idiag_vA23rms/=0) call sum_mn_name(p%va2*p%rho1**onethird,idiag_vA23rms,lsqrt=.true.)
call sum_mn_name(p%va2,idiag_vArms,lsqrt=.true.)
call max_mn_name(p%va2,idiag_vAmax,lsqrt=.true.)
if (idiag_dtb/=0) call max_mn_name(sqrt(p%advec_va2)/cdt,idiag_dtb,l_dt=.true.)
!
! Lorentz force.
!
call sum_mn_name(p%jxbr(:,1),idiag_jxbrxm)
call sum_mn_name(p%jxbr(:,2),idiag_jxbrym)
call sum_mn_name(p%jxbr(:,3),idiag_jxbrzm)
call dot(p%curlo,p%jxbr,jxbrq)
call sum_mn_name(jxbrq,idiag_jxbrqm)
call sum_mn_name(p%jxbr2,idiag_jxbr2m)
call max_mn_name(p%jxbr2,idiag_jxbrmax,lsqrt=.true.)
!
! <J.A> for calculating k_effective, for example.
!
if (idiag_ajm/=0) then
call dot(p%aa,p%jj,aj)
call sum_mn_name(aj,idiag_ajm)
endif
!
! Helicity integrals.
!
call integrate_mn_name(p%ab,idiag_ab_int)
call integrate_mn_name(p%jb,idiag_jb_int)
!
! <J.B>
!
call sum_mn_name(p%jb,idiag_jbm)
call sum_mn_name(p%hjb,idiag_hjbm)
call sum_mn_name(p%j2,idiag_j2m)
call max_mn_name(p%j2,idiag_jm2)
call sum_mn_name(p%j2,idiag_jrms,lsqrt=.true.)
call sum_mn_name(p%hj2,idiag_hjrms,lsqrt=.true.)
call max_mn_name(p%j2,idiag_jmax,lsqrt=.true.)
if (.not.lmultithread) then
if (idiag_epsM_LES/=0) call sum_mn_name(eta_smag*p%j2,idiag_epsM_LES)
if (ldt) then
if (idiag_dteta/=0) call max_mn_name(diffus_eta/cdtv,idiag_dteta,l_dt=.true.)
if (idiag_dteta3/=0) call max_mn_name(diffus_eta3/cdtv3,idiag_dteta3,l_dt=.true.)
endif
endif
call sum_mn_name(p%cosjb,idiag_cosjbm)
call sum_mn_name(p%coshjb,idiag_coshjbm)
call sum_mn_name(p%jparallel,idiag_jparallelm)
call sum_mn_name(p%jperp,idiag_jperpm)
call sum_mn_name(p%hjparallel,idiag_hjparallelm)
call sum_mn_name(p%hjperp,idiag_hjperpm)
!
! Resistivity.
!
if (.not.lmultithread) then
call sum_mn_name(eta_smag,idiag_etasmagm)
if (idiag_etasmagmin/=0) call max_mn_name(-eta_smag,idiag_etasmagmin,lneg=.true.)
call max_mn_name(eta_smag,idiag_etasmagmax)
endif
if (idiag_etaaniso/=0) call save_name(eta1_aniso/(1.+quench_aniso*Arms),idiag_etaaniso)
if (idiag_etaanisoBB/=0) call save_name(eta_aniso_BB/(1.+quench_aniso*Arms),idiag_etaanisoBB)
call max_mn_name(p%etava,idiag_etavamax)
call max_mn_name(p%etaj,idiag_etajmax)
call max_mn_name(p%etaj2,idiag_etaj2max)
call max_mn_name(p%etajrho,idiag_etajrhomax)
!
! Not correct for hyperresistivity:
!
if (.not.lmultithread) then
if (idiag_epsM/=0) call sum_mn_name(eta_total*mu0*p%j2,idiag_epsM)
if (idiag_epsM2/=0) call sum_mn_name((eta_total*mu0*p%j2)**2,idiag_epsM2)
if (idiag_epsM3/=0) call sum_mn_name((eta_total*mu0*p%j2)**3,idiag_epsM3)
if (idiag_epsM4/=0) call sum_mn_name((eta_total*mu0*p%j2)**4,idiag_epsM4)
endif
!
! Heating by ion-neutrals friction.
!
if (idiag_epsAD/=0) then
if (lambipolar_strong_coupling.and.tauAD/=0.0) then
call dot(p%jj,p%jxbxb,epsAD)
call sum_mn_name(-tauAD*epsAD,idiag_epsAD)
else
call sum_mn_name(p%nu_ni1*p%rho*p%jxbr2,idiag_epsAD)
endif
endif
!
! <A>'s, <A^2> and A^2|max
!
call sum_mn_name(p%aa(:,1),idiag_axm)
call sum_mn_name(p%aa(:,2),idiag_aym)
call sum_mn_name(p%aa(:,3),idiag_azm)
call sum_mn_name(p%a2,idiag_a2m)
call sum_mn_name(p%a2,idiag_arms,lsqrt=.true.)
call max_mn_name(p%a2,idiag_amax,lsqrt=.true.)
!
! Divergence of A
!
if (idiag_divarms /= 0) call sum_mn_name(p%diva**2, idiag_divarms, lsqrt=.true.)
!
! Calculate surface integral <2ExA>*dS.
!
if (idiag_exaym2/=0) call helflux(p%aa,p%uxb,p%jj)
!
! Calculate surface integral <2ExJ>*dS.
!
if (idiag_exjm2/=0) call curflux(p%uxb,p%jj)
!-- if (idiag_exjm2/=0) call curflux_dS(p%uxb,p%jj)
!
! Calculate emf for alpha effect (for imposed field).
! Note that uxbm means <EMF.B0>/B0^2, so it gives already alpha=EMF/B0.
!
if (idiag_uxbm/=0 .or. idiag_uxbmx/=0 .or. idiag_uxbmy/=0 .or. idiag_uxbmz/=0 &
.or. idiag_uxbcmx/=0 .or. idiag_uxbcmy/=0 &
.or. idiag_uxbsmx/=0 .or. idiag_uxbsmy/=0 ) then
if (idiag_uxbm/=0) then
call dot(B_ext_inv,p%uxb,uxb_dotB0)
call sum_mn_name(uxb_dotB0,idiag_uxbm)
endif
call sum_mn_name(p%uxbb(:,1),idiag_uxbmx)
call sum_mn_name(p%uxbb(:,2),idiag_uxbmy)
call sum_mn_name(p%uxbb(:,3),idiag_uxbmz)
if (idiag_uxbcmx/=0) call sum_mn_name(p%uxbb(:,1)*coskz(n),idiag_uxbcmx)
if (idiag_uxbcmy/=0) call sum_mn_name(p%uxbb(:,2)*coskz(n),idiag_uxbcmy)
if (idiag_uxbsmx/=0) call sum_mn_name(p%uxbb(:,1)*sinkz(n),idiag_uxbsmx)
if (idiag_uxbsmy/=0) call sum_mn_name(p%uxbb(:,2)*sinkz(n),idiag_uxbsmy)
endif
!
! Calculate part I of magnetic helicity flux (ExA contribution).
!
if (idiag_examx/=0 .or. idiag_examy/=0 .or. idiag_examz/=0 .or. &
idiag_exatop/=0 .or. idiag_exabot/=0) then
call sum_mn_name(p%exa(:,1),idiag_examx)
call sum_mn_name(p%exa(:,2),idiag_examy)
call sum_mn_name(p%exa(:,3),idiag_examz)
!
if (idiag_exabot/=0) then
if (n==n1.and.lfirst_proc_z) call integrate_mn_name(p%exa(:,3),idiag_exabot)
endif
!
if (idiag_exatop/=0) then
if (n==n2.and.llast_proc_z) call integrate_mn_name(p%exa(:,3),idiag_exatop)
endif
!
endif
!
if (idiag_exatotalmx/=0 .or. idiag_exatotalmy/=0 .or. idiag_exatotalmz/=0) then
call sum_mn_name(p%exatotal(:,1),idiag_exatotalmx)
call sum_mn_name(p%exatotal(:,2),idiag_exatotalmy)
call sum_mn_name(p%exatotal(:,3),idiag_exatotalmz)
endif
!
! Calculate part II of magnetic helicity flux (phi*B contribution).
!
if (idiag_phibmx/=0 .or. idiag_phibmy/=0 .or. idiag_phibmz/=0) then
if (lweyl_gauge) then
phi=0.
elseif (ladvective_gauge) then
phi=p%ua
else
phi=eta*p%diva
endif
call multvs(p%bb,phi,phib)
call sum_mn_name(phib(:,1),idiag_phibmx)
call sum_mn_name(phib(:,2),idiag_phibmy)
call sum_mn_name(phib(:,3),idiag_phibmz)
endif
!
! Calculate part I of current helicity flux (for imposed field).
!
if (idiag_exjmx/=0 .or. idiag_exjmy/=0 .or. idiag_exjmz/=0) then
call cross_mn(-p%uxb+eta*p%jj,p%jj,exj)
call sum_mn_name(exj(:,1),idiag_exjmx)
call sum_mn_name(exj(:,2),idiag_exjmy)
call sum_mn_name(exj(:,3),idiag_exjmz)
endif
!
! Calculate part II of current helicity flux (for imposed field).
! < curlE x B >|_i = < B_{j,i} E_j >
! Use the full B (with B_ext)
!
if (idiag_dexbmx/=0 .or. idiag_dexbmy/=0 .or. idiag_dexbmz/=0) then
call multmv_transp(p%bij,-p%uxb+eta*p%jj,dexb)
call sum_mn_name(dexb(:,1),idiag_dexbmx)
call sum_mn_name(dexb(:,2),idiag_dexbmy)
call sum_mn_name(dexb(:,3),idiag_dexbmz)
endif
!
! Calculate <uxj>.B0/B0^2.
!
if (idiag_uxjm/=0) then
call dot(B_ext_inv,p%uxj,uxj_dotB0)
call sum_mn_name(uxj_dotB0,idiag_uxjm)
endif
!
! Calculate <u x B>_rms, <resistive terms>_rms, <ratio ~ Rm>_rms.
!
call sum_mn_name(p%uxb2,idiag_uxBrms,lsqrt=.true.)
!
! Calculate <b^2*divu>, which is part of <u.(jxb)>.
! Note that <u.(jxb)>=1/2*<b^2*divu>+<u.bgradb>.
!
if (idiag_b2divum/=0) call sum_mn_name(p%b2*p%divu,idiag_b2divum)
!
! Calculate <J.del2a>.
!
if (idiag_jdel2am/=0) then
call dot(p%jj,p%del2a,jdel2a)
call sum_mn_name(jdel2a,idiag_jdel2am)
endif
!
! Calculate WL2D = <JiujAij>.
!
if (idiag_WL2D/=0) then
call dot(p%jj,p%uga,tmp)
call sum_mn_name(tmp,idiag_WL2D)
endif
!
! Calculate WL3D = -<JiujAji>.
!
if (idiag_WL3D/=0) then
call dot_mn_vm_trans(p%uu,p%aij,tmpv)
call dot(-p%jj,tmpv,tmp)
call sum_mn_name(tmp,idiag_WL3D)
endif
!
! Calculate WL3D2 = <JiAjaji>.
!
if (idiag_WL3D2/=0) then
call dot_mn_vm_trans(p%aa,p%uij,tmpv)
call dot(p%jj,tmpv,tmp)
call sum_mn_name(tmp,idiag_WL3D2)
endif
!
! Calculate bij2m = <|bhat_i,j|^2>, where bhat is the unit vector of B.
! Here, bhat_i,j = bij/|B| - Bi*nablaj(B^2/2)/|B|^3.
!
if (idiag_bij2m/=0) then
quench = 1.0/max(tini,sqrt(p%b2))
call multsm_mn(quench,p%bij,bhatij)
call multvv_smat_add(-quench**3,p%bb,p%gb22,bhatij)
call multm2_mn(bhatij,tmp)
call sum_mn_name(tmp,idiag_bij2m)
endif
!
! Calculate sijbibjm = S_{ij} B_i B_j.
!
if (idiag_sijbibjm/=0) then
call mult_mat_vv(p%sij,p%bb,p%bb,tmp)
call sum_mn_name(tmp,idiag_sijbibjm)
endif
!
! Calculate <j.E>.
!
if (idiag_jem/=0) then
call dot(p%jj,p%el,tmp)
call sum_mn_name(tmp,idiag_jem)
endif
!
! Calculate <A.E>.
!
if (idiag_aem/=0) then
call dot(p%aa,p%el,tmp)
call sum_mn_name(tmp,idiag_aem)
endif
!
! Calculate <u.(jxb)>.
!
call sum_mn_name(p%ujxb,idiag_ujxbm)
!
! Calculate <u.(B.gradB)>_\|.
!
call sum_mn_name(p%ubgbp,idiag_ubgbpm)
!
! Calculate <u.(gradB^2/2)>.
!
call sum_mn_name(p%ugb22,idiag_ugb22m)
!
! Calculate <jxb>.B_0/B_0^2.
!
if (idiag_jxbm/=0) then
call dot(B_ext_inv,p%jxb,jxb_dotB0)
call sum_mn_name(jxb_dotB0,idiag_jxbm)
endif
if (idiag_jxbmx/=0.or.idiag_jxbmy/=0.or.idiag_jxbmz/=0) then
call cross_mn(p%jj,p%bbb,jxbb)
call sum_mn_name(jxbb(:,1),idiag_jxbmx)
call sum_mn_name(jxbb(:,2),idiag_jxbmy)
call sum_mn_name(jxbb(:,3),idiag_jxbmz)
endif
if (idiag_vmagfricrms/=0 .or. idiag_vmagfricmax/=0) then
call dot2_mn(p%vmagfric,tmp1)
call sum_mn_name(tmp1,idiag_vmagfricrms,lsqrt=.true.)
call max_mn_name(tmp1,idiag_vmagfricmax)
endif
!
! Maximum difference of covariant B_i,j from bij and from bijtilde+bij_cov_corr
!
!if (ldiagnos.and.m==m2) write(iproc+10,*) p%bijtilde(:,1,1)
if (idiag_bij_cov_diffmax/=0) &
call max_mn_name(maxval(maxval(abs(p%bij-(p%bijtilde+p%bij_cov_corr)),3),2),idiag_bij_cov_diffmax) !not ok
!call max_mn_name(maxval(abs(p%bij(:,:,3)-(p%bijtilde(:,:,3)+p%bij_cov_corr(:,:,3))),2),idiag_bij_cov_diffmax) !ok
!call max_mn_name(maxval(abs(p%bij(:,:,2)-(p%bijtilde(:,:,2)+p%bij_cov_corr(:,:,2))),2),idiag_bij_cov_diffmax) !ok
!call max_mn_name(maxval(abs(p%bij(:,2:3,1)-(p%bijtilde(:,2:3,1)+p%bij_cov_corr(:,2:3,1))),2),idiag_bij_cov_diffmax) !ok
!call max_mn_name(abs(p%bij(:,1,1)-(p%bijtilde(:,1,1)+p%bij_cov_corr(:,1,1))),idiag_bij_cov_diffmax) !not ok
!
! Magnetic triple correlation term (for imposed field).
!
if (idiag_jxbxbm/=0) then
call dot(B_ext_inv,p%jxbxb,jxbxb_dotB0)
call sum_mn_name(jxbxb_dotB0,idiag_jxbxbm)
endif
!
! Triple correlation from Reynolds tensor (for imposed field).
!
if (idiag_oxuxbm/=0) then
call dot(B_ext_inv,p%oxuxb,oxuxb_dotB0)
call sum_mn_name(oxuxb_dotB0,idiag_oxuxbm)
endif
!
! Triple correlation from pressure gradient (for imposed field).
! (assume cs2=1, and that no entropy evolution is included)
! This is ok for all applications currently under consideration.
!
if (idiag_gpxbm/=0) then
call dot_mn_sv(B1_ext,p%glnrhoxb,B1dot_glnrhoxb)
call sum_mn_name(B1dot_glnrhoxb,idiag_gpxbm)
endif
!
! < u x curl(uxB) > = < E_i u_{j,j} - E_j u_{j,i} >
! ( < E_1 u2,2 + E1 u3,3 - E2 u2,1 - E3 u3,1 >
! < E_2 u1,1 + E2 u3,3 - E1 u2,1 - E3 u3,2 >
! < E_3 u1,1 + E3 u2,2 - E1 u3,1 - E2 u2,3 > )
!
if (idiag_uxDxuxbm/=0) then
uxDxuxb(:,1)=p%uxb(:,1)*(p%uij(:,2,2)+p%uij(:,3,3))-p%uxb(:,2)*p%uij(:,2,1)-p%uxb(:,3)*p%uij(:,3,1)
uxDxuxb(:,2)=p%uxb(:,2)*(p%uij(:,1,1)+p%uij(:,3,3))-p%uxb(:,1)*p%uij(:,1,2)-p%uxb(:,3)*p%uij(:,3,2)
uxDxuxb(:,3)=p%uxb(:,3)*(p%uij(:,1,1)+p%uij(:,2,2))-p%uxb(:,1)*p%uij(:,1,3)-p%uxb(:,2)*p%uij(:,2,3)
call dot(B_ext_inv,uxDxuxb,uxDxuxb_dotB0)
call sum_mn_name(uxDxuxb_dotB0,idiag_uxDxuxbm)
endif
!
! alpM11=<b3*b2,1>
!
if (idiag_b3b21m/=0) then
b3b21=p%bb(:,3)*p%bij(:,2,1)
call sum_mn_name(b3b21,idiag_b3b21m)
endif
!
! alpM11=<b3*b1,2>
!
if (idiag_b3b12m/=0) then
b3b12=p%bb(:,3)*p%bij(:,1,2)
call sum_mn_name(b3b12,idiag_b3b12m)
endif
!
! alpM22=<b1*b3,2>
!
if (idiag_b1b32m/=0) then
b1b32=p%bb(:,1)*p%bij(:,3,2)
call sum_mn_name(b1b32,idiag_b1b32m)
endif
!
! alpM22=<b1*b2,3>
!
if (idiag_b1b23m/=0) then
b1b23=p%bb(:,1)*p%bij(:,2,3)
call sum_mn_name(b1b23,idiag_b1b23m)
endif
!
! alpM33=<b2*b1,3>
!
if (idiag_b2b13m/=0) then
b2b13=p%bb(:,2)*p%bij(:,1,3)
call sum_mn_name(b2b13,idiag_b2b13m)
endif
!
! alpM33=<b2*b3,1>
!
if (idiag_b2b31m/=0) then
b2b31=p%bb(:,2)*p%bij(:,3,1)
call sum_mn_name(b2b31,idiag_b2b31m)
endif
!
! eta_tdep as diagnostics:
!
if (lresi_eta_tdep) then
if (lroot) call save_name(eta_tdep,idiag_eta_tdep)
elseif (lresi_eta_xtdep) then
call sum_mn_name(eta_xtdep,idiag_eta_tdep)
endif
!
! current density components at one point (=pt).
!
if (lroot.and.m==mpoint.and.n==npoint) then
!MR: i.e., only pointwise data from root proc domain can be obtained! Intended?
call save_name(p%bb(lpoint-nghost,1),idiag_bxpt)
call save_name(p%bb(lpoint-nghost,2),idiag_bypt)
call save_name(p%bb(lpoint-nghost,3),idiag_bzpt)
if (idiag_bxbypt/=0) call save_name(p%bb(lpoint-nghost,1)*p%bb(lpoint-nghost,2),idiag_bxbypt)
if (idiag_bybzpt/=0) call save_name(p%bb(lpoint-nghost,2)*p%bb(lpoint-nghost,3),idiag_bybzpt)
if (idiag_bzbxpt/=0) call save_name(p%bb(lpoint-nghost,3)*p%bb(lpoint-nghost,1),idiag_bzbxpt)
call save_name(p%jj(lpoint-nghost,1),idiag_jxpt)
call save_name(p%jj(lpoint-nghost,2),idiag_jypt)
call save_name(p%jj(lpoint-nghost,3),idiag_jzpt)
endif
!
if (lforcing_cont_aa_local) then
if (idiag_jfm/=0) then
call dot_mn(p%jj,forcing_rhs,tmp)
call sum_mn_name(tmp,idiag_jfm)
endif
endif
!
! current density components at point 2 (=p2).
!
if (lroot.and.m==mpoint2.and.n==npoint2) then
if (idiag_bxp2/=0) call save_name(p%bb(lpoint2-nghost,1),idiag_bxp2)
if (idiag_byp2/=0) call save_name(p%bb(lpoint2-nghost,2),idiag_byp2)
if (idiag_bzp2/=0) call save_name(p%bb(lpoint2-nghost,3),idiag_bzp2)
if (idiag_jxp2/=0) call save_name(p%jj(lpoint2-nghost,1),idiag_jxp2)
if (idiag_jyp2/=0) call save_name(p%jj(lpoint2-nghost,2),idiag_jyp2)
if (idiag_jzp2/=0) call save_name(p%jj(lpoint2-nghost,3),idiag_jzp2)
endif
!
if (bthresh_per_brms/=0) call vecout(41,trim(directory)//'/bvec',p%bb,bthresh,nbvec)
!
endsubroutine calc_0d_diagnostics_magnetic
!******************************************************************************
subroutine calc_1d_diagnostics_magnetic(p)
!
! 2-D averages.
! Note that this does not necessarily happen with ldiagnos=.true.
!
use Diagnostics
use Sub, only: dot2_mn, dot
type(pencil_case) :: p
real, dimension(nx) :: fres2, tmp1, Rmmz, bdel2a, jdel2a
!
! 1d-averages. Happens at every it1d timesteps, NOT at every it1.
!
if (l1davgfirst .or. (ldiagnos .and. ldiagnos_need_zaverages)) then
call yzsum_mn_name_x(p%b2, idiag_b2mx)
call yzsum_mn_name_x(p%bb(:,1),idiag_bxmx)
call yzsum_mn_name_x(p%bb(:,2),idiag_bymx)
call yzsum_mn_name_x(p%bb(:,3),idiag_bzmx)
if (idiag_bx2mx/=0) call yzsum_mn_name_x(p%bb(:,1)**2,idiag_bx2mx)
if (idiag_by2mx/=0) call yzsum_mn_name_x(p%bb(:,2)**2,idiag_by2mx)
if (idiag_bz2mx/=0) call yzsum_mn_name_x(p%bb(:,3)**2,idiag_bz2mx)
if (idiag_bxbymx/=0) call yzsum_mn_name_x(p%bbb(:,1)*p%bbb(:,2),idiag_bxbymx)
if (idiag_bxbzmx/=0) call yzsum_mn_name_x(p%bbb(:,1)*p%bbb(:,3),idiag_bxbzmx)
if (idiag_bybzmx/=0) call yzsum_mn_name_x(p%bbb(:,2)*p%bbb(:,3),idiag_bybzmx)
call yzsum_mn_name_x(p%beta, idiag_betamx)
call xzsum_mn_name_y(p%bb(:,1),idiag_bxmy)
call xzsum_mn_name_y(p%bb(:,2),idiag_bymy)
call xzsum_mn_name_y(p%bb(:,3),idiag_bzmy)
if (idiag_beta2mx/=0) call yzsum_mn_name_x(p%beta**2, idiag_beta2mx)
if (idiag_bx2my/=0) call xzsum_mn_name_y(p%bb(:,1)**2,idiag_bx2my)
if (idiag_by2my/=0) call xzsum_mn_name_y(p%bb(:,2)**2,idiag_by2my)
if (idiag_bz2my/=0) call xzsum_mn_name_y(p%bb(:,3)**2,idiag_bz2my)
call xysum_mn_name_z(p%aa(:,1),idiag_axmz)
call xysum_mn_name_z(p%aa(:,2),idiag_aymz)
call xysum_mn_name_z(p%aa(:,3),idiag_azmz)
if (idiag_abuxmz/=0) call xysum_mn_name_z(p%ab*p%uu(:,1),idiag_abuxmz)
if (idiag_abuymz/=0) call xysum_mn_name_z(p%ab*p%uu(:,2),idiag_abuymz)
if (idiag_abuzmz/=0) call xysum_mn_name_z(p%ab*p%uu(:,3),idiag_abuzmz)
if (idiag_uabxmz/=0) call xysum_mn_name_z(p%ua*p%bb(:,1),idiag_uabxmz)
if (idiag_uabymz/=0) call xysum_mn_name_z(p%ua*p%bb(:,2),idiag_uabymz)
if (idiag_uabzmz/=0) call xysum_mn_name_z(p%ua*p%bb(:,3),idiag_uabzmz)
call xysum_mn_name_z(p%bbb(:,1),idiag_bbxmz)
call xysum_mn_name_z(p%bbb(:,2),idiag_bbymz)
call xysum_mn_name_z(p%bbb(:,3),idiag_bbzmz)
call xysum_mn_name_z(p%bb(:,1),idiag_bxmz)
call xysum_mn_name_z(p%bb(:,2),idiag_bymz)
call xysum_mn_name_z(p%bb(:,3),idiag_bzmz)
call xysum_mn_name_z(p%jj(:,1),idiag_jxmz)
call xysum_mn_name_z(p%jj(:,2),idiag_jymz)
call xysum_mn_name_z(p%jj(:,3),idiag_jzmz)
call xysum_mn_name_z(p%uxb(:,1),idiag_Exmz)
call xysum_mn_name_z(p%uxb(:,2),idiag_Eymz)
call xysum_mn_name_z(p%uxb(:,3),idiag_Ezmz)
if (idiag_bx2mz/=0) call xysum_mn_name_z(p%bb(:,1)**2,idiag_bx2mz)
if (idiag_by2mz/=0) call xysum_mn_name_z(p%bb(:,2)**2,idiag_by2mz)
if (idiag_bz2mz/=0) call xysum_mn_name_z(p%bb(:,3)**2,idiag_bz2mz)
if (idiag_bx2rmz/=0) call xysum_mn_name_z(p%bb(:,1)**2*p%rho1,idiag_bx2rmz)
if (idiag_by2rmz/=0) call xysum_mn_name_z(p%bb(:,2)**2*p%rho1,idiag_by2rmz)
if (idiag_bz2rmz/=0) call xysum_mn_name_z(p%bb(:,3)**2*p%rho1,idiag_bz2rmz)
if (idiag_beta2mz/=0) call xysum_mn_name_z(p%beta**2, idiag_beta2mz)
call xysum_mn_name_z(p%beta1,idiag_beta1mz)
call xysum_mn_name_z(p%beta, idiag_betamz)
call xysum_mn_name_z(p%jb,idiag_jbmz)
if (idiag_bxph1mz/=0) call xysum_mn_name_z(p%bb(:,1),idiag_bxph1mz,MASK=(p%ss <=ssmask1))
if (idiag_bxph2mz/=0) call xysum_mn_name_z(p%bb(:,1),idiag_bxph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2))
if (idiag_bxph3mz/=0) call xysum_mn_name_z(p%bb(:,1),idiag_bxph3mz,MASK=(p%ss > ssmask2))
if (idiag_byph1mz/=0) call xysum_mn_name_z(p%bb(:,2),idiag_byph1mz,MASK=(p%ss <=ssmask1))
if (idiag_byph2mz/=0) call xysum_mn_name_z(p%bb(:,2),idiag_byph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2))
if (idiag_byph3mz/=0) call xysum_mn_name_z(p%bb(:,2),idiag_byph3mz,MASK=(p%ss > ssmask2))
if (idiag_bzph1mz/=0) call xysum_mn_name_z(p%bb(:,3),idiag_bzph1mz,MASK=(p%ss <=ssmask1))
if (idiag_bzph2mz/=0) call xysum_mn_name_z(p%bb(:,3),idiag_bzph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2))
if (idiag_bzph3mz/=0) call xysum_mn_name_z(p%bb(:,3),idiag_bzph3mz,MASK=(p%ss > ssmask2))
if (idiag_bx2ph1mz/=0) call xysum_mn_name_z(p%bb(:,1)**2,idiag_bx2ph1mz,MASK=(p%ss <=ssmask1))
if (idiag_bx2ph2mz/=0) call xysum_mn_name_z(p%bb(:,1)**2,idiag_bx2ph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2))
if (idiag_bx2ph3mz/=0) call xysum_mn_name_z(p%bb(:,1)**2,idiag_bx2ph3mz,MASK=(p%ss > ssmask2))
if (idiag_by2ph1mz/=0) call xysum_mn_name_z(p%bb(:,2)**2,idiag_by2ph1mz,MASK=(p%ss <=ssmask1))
if (idiag_by2ph2mz/=0) call xysum_mn_name_z(p%bb(:,2)**2,idiag_by2ph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2))
if (idiag_by2ph3mz/=0) call xysum_mn_name_z(p%bb(:,2)**2,idiag_by2ph3mz,MASK=(p%ss > ssmask2))
if (idiag_bz2ph1mz/=0) call xysum_mn_name_z(p%bb(:,3)**2,idiag_bz2ph1mz,MASK=(p%ss <=ssmask1))
if (idiag_bz2ph2mz/=0) call xysum_mn_name_z(p%bb(:,3)**2,idiag_bz2ph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2))
if (idiag_bz2ph3mz/=0) call xysum_mn_name_z(p%bb(:,3)**2,idiag_bz2ph3mz,MASK=(p%ss > ssmask2))
if (idiag_jxph1mz/=0) call xysum_mn_name_z(p%jj(:,1),idiag_jxph1mz,MASK=(p%ss <=ssmask1))
if (idiag_jxph2mz/=0) call xysum_mn_name_z(p%jj(:,1),idiag_jxph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2))
if (idiag_jxph3mz/=0) call xysum_mn_name_z(p%jj(:,1),idiag_jxph3mz,MASK=(p%ss > ssmask2))
if (idiag_jyph1mz/=0) call xysum_mn_name_z(p%jj(:,2),idiag_jyph1mz,MASK=(p%ss <=ssmask1))
if (idiag_jyph2mz/=0) call xysum_mn_name_z(p%jj(:,2),idiag_jyph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2))
if (idiag_jyph3mz/=0) call xysum_mn_name_z(p%jj(:,2),idiag_jyph3mz,MASK=(p%ss > ssmask2))
if (idiag_jzph1mz/=0) call xysum_mn_name_z(p%jj(:,3),idiag_jzph1mz,MASK=(p%ss <=ssmask1))
if (idiag_jzph2mz/=0) call xysum_mn_name_z(p%jj(:,3),idiag_jzph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2))
if (idiag_jzph3mz/=0) call xysum_mn_name_z(p%jj(:,3),idiag_jzph3mz,MASK=(p%ss > ssmask2))
if (idiag_bx2rph1mz/=0) call xysum_mn_name_z(p%bb(:,1)**2*p%rho1,idiag_bx2rph1mz, &
MASK=(p%ss <=ssmask1))
if (idiag_bx2rph2mz/=0) call xysum_mn_name_z(p%bb(:,1)**2*p%rho1,idiag_bx2rph2mz, &
MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2))
if (idiag_bx2rph3mz/=0) call xysum_mn_name_z(p%bb(:,1)**2*p%rho1,idiag_bx2rph3mz, &
MASK=(p%ss > ssmask2))
if (idiag_by2rph1mz/=0) call xysum_mn_name_z(p%bb(:,2)**2*p%rho1,idiag_by2rph1mz, &
MASK=(p%ss <=ssmask1))
if (idiag_by2rph2mz/=0) call xysum_mn_name_z(p%bb(:,2)**2*p%rho1,idiag_by2rph2mz, &
MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2))
if (idiag_by2rph3mz/=0) call xysum_mn_name_z(p%bb(:,2)**2*p%rho1,idiag_by2rph3mz, &
MASK=(p%ss > ssmask2))
if (idiag_bz2rph1mz/=0) call xysum_mn_name_z(p%bb(:,3)**2*p%rho1,idiag_bz2rph1mz, &
MASK=(p%ss <=ssmask1))
if (idiag_bz2rph2mz/=0) call xysum_mn_name_z(p%bb(:,3)**2*p%rho1,idiag_bz2rph2mz, &
MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2))
if (idiag_bz2rph3mz/=0) call xysum_mn_name_z(p%bb(:,3)**2*p%rho1,idiag_bz2rph3mz, &
MASK=(p%ss > ssmask2))
if (idiag_abph1mz/=0) call xysum_mn_name_z(p%ab,idiag_abph1mz,MASK=(p%ss <=ssmask1))
if (idiag_abph2mz/=0) call xysum_mn_name_z(p%ab,idiag_abph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2))
if (idiag_abph3mz/=0) call xysum_mn_name_z(p%ab,idiag_abph3mz,MASK=(p%ss > ssmask2))
if (idiag_jbph1mz/=0) call xysum_mn_name_z(p%jb,idiag_jbph1mz,MASK=(p%ss <=ssmask1))
if (idiag_jbph2mz/=0) call xysum_mn_name_z(p%jb,idiag_jbph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2))
if (idiag_jbph3mz/=0) call xysum_mn_name_z(p%jb,idiag_jbph3mz,MASK=(p%ss > ssmask2))
if (idiag_poynzph1mz/=0) call xysum_mn_name_z(eta_total*p%jxb(:,3)-mu01* &
(p%uxb(:,1)*p%bb(:,2)-p%uxb(:,2)*p%bb(:,1)),idiag_poynzph1mz,MASK=(p%ss <=ssmask1))
if (idiag_poynzph2mz/=0) call xysum_mn_name_z(eta_total*p%jxb(:,3)-mu01* &
(p%uxb(:,1)*p%bb(:,2)-p%uxb(:,2)*p%bb(:,1)),idiag_poynzph2mz,MASK=(p%ss > ssmask1 .and. p%ss <= ssmask2))
if (idiag_poynzph3mz/=0) call xysum_mn_name_z(eta_total*p%jxb(:,3)-mu01* &
(p%uxb(:,1)*p%bb(:,2)-p%uxb(:,2)*p%bb(:,1)),idiag_poynzph3mz,MASK=(p%ss >ssmask2))
!
! Calculate <B.del2a>_{xy}.
!
if (idiag_bdel2amz/=0) then
call dot(p%bb,p%del2a,bdel2a)
call xysum_mn_name_z(bdel2a,idiag_bdel2amz)
endif
!
! Calculate <J.del2a>_{xy}.
!
if (idiag_jdel2amz/=0) then
call dot(p%jj,p%del2a,jdel2a)
call xysum_mn_name_z(jdel2a,idiag_jdel2amz)
endif
!
call xysum_mn_name_z(p%d6ab,idiag_d6abmz)
call xysum_mn_name_z(p%del6a(:,1),idiag_d6amz1)
call xysum_mn_name_z(p%del6a(:,2),idiag_d6amz2)
call xysum_mn_name_z(p%del6a(:,3),idiag_d6amz3)
call xysum_mn_name_z(p%ab,idiag_abmz)
call xysum_mn_name_z(p%ub,idiag_ubmz)
call xysum_mn_name_z(p%uj,idiag_ujmz)
call xysum_mn_name_z(p%ob,idiag_obmz)
call xysum_mn_name_z(p%ua,idiag_uamz)
call xysum_mn_name_z(p%bb(:,3)*p%ua,idiag_bzuamz)
call xysum_mn_name_z(p%bb(:,3)*p%aa(:,2),idiag_bzaymz)
call xysum_mn_name_z(p%diva,idiag_divamz)
if (idiag_bzdivamz/=0) call xysum_mn_name_z(p%bb(:,3)*p%diva,idiag_bzdivamz)
if (idiag_bzLammz/=0) call xysum_mn_name_z(p%bb(:,3)*p%Lam,idiag_bzLammz)
if (idiag_uxbxmz/=0) call xysum_mn_name_z(p%uu(:,1)*p%bb(:,1),idiag_uxbxmz)
if (idiag_uybxmz/=0) call xysum_mn_name_z(p%uu(:,2)*p%bb(:,1),idiag_uybxmz)
if (idiag_uzbxmz/=0) call xysum_mn_name_z(p%uu(:,3)*p%bb(:,1),idiag_uzbxmz)
if (idiag_uxbymz/=0) call xysum_mn_name_z(p%uu(:,1)*p%bb(:,2),idiag_uxbymz)
if (idiag_uybymz/=0) call xysum_mn_name_z(p%uu(:,2)*p%bb(:,2),idiag_uybymz)
if (idiag_uzbymz/=0) call xysum_mn_name_z(p%uu(:,3)*p%bb(:,2),idiag_uzbymz)
if (idiag_uxbzmz/=0) call xysum_mn_name_z(p%uu(:,1)*p%bb(:,3),idiag_uxbzmz)
if (idiag_uybzmz/=0) call xysum_mn_name_z(p%uu(:,2)*p%bb(:,3),idiag_uybzmz)
if (idiag_uzbzmz/=0) call xysum_mn_name_z(p%uu(:,3)*p%bb(:,3),idiag_uzbzmz)
call xysum_mn_name_z(p%ujxb,idiag_ujxbmz)
if (.not.lmultithread) then
if (idiag_epsMmz/=0) call xysum_mn_name_z(eta_total*mu0*p%j2,idiag_epsMmz)
call yzsum_mn_name_x(eta_total,idiag_etatotalmx)
call xysum_mn_name_z(eta_total,idiag_etatotalmz)
endif
if (idiag_vmagfricmz/=0) then
call dot2_mn(p%vmagfric,tmp1)
call xysum_mn_name_z(tmp1,idiag_vmagfricmz)
endif
!
! Calculate magnetic helicity flux (ExA contribution).
!
call xysum_mn_name_z(p%exa(:,1),idiag_examz1)
call xysum_mn_name_z(p%exa(:,2),idiag_examz2)
call xysum_mn_name_z(p%exa(:,3),idiag_examz3)
!
! Calculate magnetic helicity flux (ExA contribution).
!
call xysum_mn_name_z(p%exatotal(:,1),idiag_exatotalmz1)
call xysum_mn_name_z(p%exatotal(:,2),idiag_exatotalmz2)
call xysum_mn_name_z(p%exatotal(:,3),idiag_exatotalmz3)
!
! Calculate magnetic helicity flux for n=3 hyperdiffusion (E^{(3)}xA contribution).
!
call xysum_mn_name_z(p%e3xa(:,1),idiag_e3xamz1)
call xysum_mn_name_z(p%e3xa(:,2),idiag_e3xamz2)
call xysum_mn_name_z(p%e3xa(:,3),idiag_e3xamz3)
!
! Maxwell stress components.
!
if (idiag_bxbymy/=0) call xzsum_mn_name_y(p%bbb(:,1)*p%bbb(:,2),idiag_bxbymy)
if (idiag_bxbzmy/=0) call xzsum_mn_name_y(p%bbb(:,1)*p%bbb(:,3),idiag_bxbzmy)
if (idiag_bybzmy/=0) call xzsum_mn_name_y(p%bbb(:,2)*p%bbb(:,3),idiag_bybzmy)
if (idiag_ay2mz/=0) call xysum_mn_name_z( p%aa(:,2)**2 ,idiag_ay2mz)
if (idiag_aybxmz/=0) call xysum_mn_name_z( p%aa(:,2)*p%bbb(:,1),idiag_aybxmz)
if (idiag_bxbymz/=0) call xysum_mn_name_z(p%bbb(:,1)*p%bbb(:,2),idiag_bxbymz)
if (idiag_bxbzmz/=0) call xysum_mn_name_z(p%bbb(:,1)*p%bbb(:,3),idiag_bxbzmz)
if (idiag_bybzmz/=0) call xysum_mn_name_z(p%bbb(:,2)*p%bbb(:,3),idiag_bybzmz)
call yzsum_mn_name_x(p%jxbr(:,1),idiag_jxbrxmx)
call yzsum_mn_name_x(p%jxbr(:,2),idiag_jxbrymx)
call yzsum_mn_name_x(p%jxbr(:,3),idiag_jxbrzmx)
call xzsum_mn_name_y(p%jxbr(:,1),idiag_jxbrxmy)
call xzsum_mn_name_y(p%jxbr(:,2),idiag_jxbrymy)
call xzsum_mn_name_y(p%jxbr(:,3),idiag_jxbrzmy)
call xysum_mn_name_z(p%jxbr(:,1),idiag_jxbrxmz)
call xysum_mn_name_z(p%jxbr(:,2),idiag_jxbrymz)
call xysum_mn_name_z(p%jxbr(:,3),idiag_jxbrzmz)
call xysum_mn_name_z(p%a2,idiag_a2mz)
call xysum_mn_name_z(p%b2,idiag_b2mz)
call xysum_mn_name_z(p%bf2,idiag_bf2mz)
call xysum_mn_name_z(p%j2,idiag_j2mz)
if (.not.lmultithread) then
if (idiag_poynzmz/=0) call xysum_mn_name_z(eta_total*p%jxb(:,3)-mu01* &
(p%uxb(:,1)*p%bb(:,2)-p%uxb(:,2)*p%bb(:,1)),idiag_poynzmz)
endif
call phizsum_mn_name_r(p%b2,idiag_b2mr)
if (idiag_brmr/=0) call phizsum_mn_name_r(p%bb(:,1)*p%pomx+p%bb(:,2)*p%pomy,idiag_brmr)
if (idiag_bpmr/=0) call phizsum_mn_name_r(p%bb(:,1)*p%phix+p%bb(:,2)*p%phiy,idiag_bpmr)
call phizsum_mn_name_r(p%bb(:,3),idiag_bzmr)
if (idiag_armr/=0) call phizsum_mn_name_r(p%aa(:,1)*p%pomx+p%aa(:,2)*p%pomy,idiag_armr)
if (idiag_apmr/=0) call phizsum_mn_name_r(p%aa(:,1)*p%phix+p%aa(:,2)*p%phiy,idiag_apmr)
call phizsum_mn_name_r(p%aa(:,3),idiag_azmr)
call yzintegrate_mn_name_x(p%bb(:,1),idiag_mflux_x)
call xzintegrate_mn_name_y(p%bb(:,2),idiag_mflux_y)
call xyintegrate_mn_name_z(p%bb(:,3),idiag_mflux_z)
if (.not.lmultithread) then
!
! This diagnostic relies upon mn-dependent quantities which are not in the pencil case.
!
if (idiag_Rmmz/=0) then
call dot2_mn(fres,fres2)
Rmmz=sqrt(p%uxb2/fres2)
where (fres2 < tini) Rmmz = 0.
call xysum_mn_name_z(Rmmz,idiag_Rmmz)
endif
endif
endif
endsubroutine calc_1d_diagnostics_magnetic
!***********************************************************************
subroutine calc_2d_diagnostics_magnetic(p)
!
! 2-D averages.
! Note that this does not necessarily happen with ldiagnos=.true.
!
use Diagnostics
type(pencil_case) :: p
real, dimension(nx,3) :: tmp2
if (l2davgfirst) then
if (idiag_brmphi/=0) call phisum_mn_name_rz(p%bb(:,1)*p%pomx+p%bb(:,2)*p%pomy,idiag_brmphi)
if (idiag_br2mphi/=0) call phisum_mn_name_rz((p%bb(:,1)*p%pomx+p%bb(:,2)*p%pomy)**2,idiag_br2mphi)
if (idiag_brsphmphi/=0) call phisum_mn_name_rz(p%bb(:,1)*p%evr(:,1)+ &
p%bb(:,2)*p%evr(:,2)+p%bb(:,3)*p%evr(:,3),idiag_brsphmphi)
if (idiag_bthmphi/=0) call phisum_mn_name_rz(p%bb(:,1)*p%evth(:,1)+ &
p%bb(:,2)*p%evth(:,2)+p%bb(:,3)*p%evth(:,3),idiag_bthmphi)
if (idiag_bpmphi/=0) call phisum_mn_name_rz(p%bb(:,1)*p%phix+p%bb(:,2)*p%phiy,idiag_bpmphi)
if (idiag_bp2mphi/=0) call phisum_mn_name_rz((p%bb(:,1)*p%phix+p%bb(:,2)*p%phiy)**2,idiag_bp2mphi)
call phisum_mn_name_rz(p%bb(:,3),idiag_bzmphi)
if (idiag_bz2mphi/=0) call phisum_mn_name_rz(p%bb(:,3)**2,idiag_bz2mphi)
call phisum_mn_name_rz(p%b2,idiag_b2mphi)
if (idiag_brbpmphi/=0) &
call phisum_mn_name_rz((p%bb(:,1)*p%pomx+p%bb(:,2)*p%pomy)*(p%bb(:,1)*p%phix+p%bb(:,2)*p%phiy),idiag_brbpmphi)
if (idiag_brbzmphi/=0) &
call phisum_mn_name_rz((p%bb(:,1)*p%pomx+p%bb(:,2)*p%pomy)*p%bb(:,3),idiag_brbzmphi)
if (idiag_bpbzmphi/=0) &
call phisum_mn_name_rz((p%bb(:,1)*p%phix+p%bb(:,2)*p%phiy)*p%bb(:,3),idiag_bpbzmphi)
if (idiag_jbmphi/=0) call phisum_mn_name_rz(p%jb,idiag_jbmphi)
if (any((/idiag_uxbrmphi,idiag_uxbpmphi,idiag_uxbzmphi/) /= 0)) then
if (idiag_uxbrmphi/=0) call phisum_mn_name_rz(p%uxb(:,1)*p%pomx+p%uxb(:,2)*p%pomy,idiag_uxbrmphi)
if (idiag_uxbpmphi/=0) call phisum_mn_name_rz(p%uxb(:,1)*p%phix+p%uxb(:,2)*p%phiy,idiag_uxbpmphi)
call phisum_mn_name_rz(p%uxb(:,3),idiag_uxbzmphi)
endif
if (any((/idiag_jxbrmphi,idiag_jxbpmphi,idiag_jxbzmphi/) /= 0)) then
if (idiag_jxbrmphi/=0) call phisum_mn_name_rz(p%jxb(:,1)*p%pomx+p%jxb(:,2)*p%pomy,idiag_jxbrmphi)
if (idiag_jxbpmphi/=0) call phisum_mn_name_rz(p%jxb(:,1)*p%phix+p%jxb(:,2)*p%phiy,idiag_jxbpmphi)
call phisum_mn_name_rz(p%jxb(:,3),idiag_jxbzmphi)
endif
if (any((/idiag_armphi,idiag_apmphi,idiag_azmphi/) /= 0)) then
if (idiag_armphi/=0) call phisum_mn_name_rz(p%aa(:,1)*p%pomx+p%aa(:,2)*p%pomy,idiag_armphi)
if (idiag_apmphi/=0) call phisum_mn_name_rz(p%aa(:,1)*p%phix+p%aa(:,2)*p%phiy,idiag_apmphi)
call phisum_mn_name_rz(p%aa(:,3),idiag_azmphi)
endif
call zsum_mn_name_xy(p%bb(:,1),idiag_bxmxy)
call zsum_mn_name_xy(p%bb,idiag_bymxy,(/0,1,0/))
call zsum_mn_name_xy(p%bb,idiag_bzmxy,(/0,0,1/))
call zsum_mn_name_xy(p%jj(:,1),idiag_jxmxy)
call zsum_mn_name_xy(p%jj,idiag_jymxy,(/0,1,0/))
call zsum_mn_name_xy(p%jj,idiag_jzmxy,(/0,0,1/))
call zsum_mn_name_xy(p%aa(:,1),idiag_axmxy)
call zsum_mn_name_xy(p%aa,idiag_aymxy,(/0,1,0/))
call zsum_mn_name_xy(p%aa,idiag_azmxy,(/0,0,1/))
if (lcovariant_magnetic) then
if (idiag_dbxdxmxy/=0) call zsum_mn_name_xy(p%bijtilde(:,1,1)+p%bij_cov_corr(:,1,1),idiag_dbxdxmxy)
if (idiag_dbxdymxy/=0) call zsum_mn_name_xy(p%bijtilde(:,1,2)+p%bij_cov_corr(:,1,2),idiag_dbxdymxy)
if (idiag_dbxdzmxy/=0) call zsum_mn_name_xy(p%bijtilde(:,1,3)+p%bij_cov_corr(:,1,3),idiag_dbxdzmxy)
if (idiag_dbydxmxy/=0) call zsum_mn_name_xy(p%bijtilde(:,2,1)+p%bij_cov_corr(:,2,1),idiag_dbydxmxy)
if (idiag_dbydymxy/=0) call zsum_mn_name_xy(p%bijtilde(:,2,2)+p%bij_cov_corr(:,2,2),idiag_dbydymxy)
if (idiag_dbydzmxy/=0) call zsum_mn_name_xy(p%bijtilde(:,2,3)+p%bij_cov_corr(:,2,3),idiag_dbydzmxy)
if (idiag_dbzdxmxy/=0) call zsum_mn_name_xy(p%bijtilde(:,3,1)+p%bij_cov_corr(:,3,1),idiag_dbzdxmxy)
if (idiag_dbzdymxy/=0) call zsum_mn_name_xy(p%bijtilde(:,3,2)+p%bij_cov_corr(:,3,2),idiag_dbzdymxy)
if (idiag_dbzdzmxy/=0) call zsum_mn_name_xy(p%bijtilde(:,3,3)+p%bij_cov_corr(:,3,3),idiag_dbzdzmxy)
!if (idiag_dbxdxmxy/=0)&
! call zsum_mn_name_xy(p%bijtilde(:,1,1)+p%bij_cov_corr(:,1,1)-p%bij(:,1,1),idiag_dbxdxmxy)
!if (idiag_dbxdymxy/=0)&
! call zsum_mn_name_xy(p%bijtilde(:,1,2)+p%bij_cov_corr(:,1,2)-p%bij(:,1,2),idiag_dbxdymxy)
!if (idiag_dbxdzmxy/=0)&
! call zsum_mn_name_xy(p%bijtilde(:,1,3)+p%bij_cov_corr(:,1,3)-p%bij(:,1,3),idiag_dbxdzmxy)
!if (idiag_dbydxmxy/=0)&
! call zsum_mn_name_xy(p%bijtilde(:,2,1)+p%bij_cov_corr(:,2,1)-p%bij(:,2,1),idiag_dbydxmxy)
!if (idiag_dbydymxy/=0)&
! call zsum_mn_name_xy(p%bijtilde(:,2,2)+p%bij_cov_corr(:,2,2)-p%bij(:,2,2),idiag_dbydymxy)
!if (idiag_dbydzmxy/=0)&
! call zsum_mn_name_xy(p%bijtilde(:,2,3)+p%bij_cov_corr(:,2,3)-p%bij(:,2,3),idiag_dbydzmxy)
!if (idiag_dbzdxmxy/=0)&
! call zsum_mn_name_xy(p%bijtilde(:,3,1)+p%bij_cov_corr(:,3,1)-p%bij(:,3,1),idiag_dbzdxmxy)
!if (idiag_dbzdymxy/=0)&
! call zsum_mn_name_xy(p%bijtilde(:,3,2)+p%bij_cov_corr(:,3,2)-p%bij(:,3,2),idiag_dbzdymxy)
!if (idiag_dbzdzmxy/=0)&
! call zsum_mn_name_xy(p%bijtilde(:,3,3)+p%bij_cov_corr(:,3,3)-p%bij(:,3,3),idiag_dbzdzmxy)
else
call zsum_mn_name_xy(p%bijtilde(:,1,1),idiag_dbxdxmxy)
call zsum_mn_name_xy(p%bijtilde(:,1,2),idiag_dbxdymxy)
call zsum_mn_name_xy(p%bijtilde(:,2,1),idiag_dbydxmxy)
call zsum_mn_name_xy(p%bijtilde(:,2,2),idiag_dbydymxy)
call zsum_mn_name_xy(p%bijtilde(:,3,1),idiag_dbzdxmxy)
call zsum_mn_name_xy(p%bijtilde(:,3,2),idiag_dbzdymxy)
endif
!
call ysum_mn_name_xz(p%b2,idiag_b2mxz)
call ysum_mn_name_xz(p%aa(:,1),idiag_axmxz)
call ysum_mn_name_xz(p%aa(:,2),idiag_aymxz)
call ysum_mn_name_xz(p%aa(:,3),idiag_azmxz)
if (idiag_bx1mxz/=0) call ysum_mn_name_xz(abs(p%bb(:,1)),idiag_bx1mxz)
if (idiag_by1mxz/=0) call ysum_mn_name_xz(abs(p%bb(:,2)),idiag_by1mxz)
if (idiag_bz1mxz/=0) call ysum_mn_name_xz(abs(p%bb(:,3)),idiag_bz1mxz)
call ysum_mn_name_xz(p%bb(:,1),idiag_bxmxz)
call ysum_mn_name_xz(p%bb(:,2),idiag_bymxz)
call ysum_mn_name_xz(p%bb(:,3),idiag_bzmxz)
call ysum_mn_name_xz(p%jj(:,1),idiag_jxmxz)
call ysum_mn_name_xz(p%jj(:,2),idiag_jymxz)
call ysum_mn_name_xz(p%jj(:,3),idiag_jzmxz)
if (idiag_bx2mxz/=0) call ysum_mn_name_xz(p%bb(:,1)**2,idiag_bx2mxz)
if (idiag_by2mxz/=0) call ysum_mn_name_xz(p%bb(:,2)**2,idiag_by2mxz)
if (idiag_bz2mxz/=0) call ysum_mn_name_xz(p%bb(:,3)**2,idiag_bz2mxz)
!
if (idiag_bx2mxy/=0) call zsum_mn_name_xy(p%bb(:,1)**2,idiag_bx2mxy)
call zsum_mn_name_xy(p%bb,idiag_by2mxy,(/0,2,0/))
call zsum_mn_name_xy(p%bb,idiag_bz2mxy,(/0,0,2/))
call zsum_mn_name_xy(p%jb,idiag_jbmxy)
call zsum_mn_name_xy(p%ab,idiag_abmxy)
call zsum_mn_name_xy(p%ub,idiag_ubmxy)
call zsum_mn_name_xy(p%exa(:,1),idiag_examxy1)
call zsum_mn_name_xy(p%exa,idiag_examxy2,(/0,1,0/))
call zsum_mn_name_xy(p%exa,idiag_examxy3,(/0,0,1/))
call zsum_mn_name_xy(p%uxb(:,1),idiag_Exmxy)
call zsum_mn_name_xy(p%uxb,idiag_Eymxy,(/0,1,0/))
call zsum_mn_name_xy(p%uxb,idiag_Ezmxy,(/0,0,1/))
if (.not.lmultithread) then
if (idiag_poynxmxy/=0) &
call zsum_mn_name_xy(eta_total*p%jxb(:,1)-mu01* &
(p%uxb(:,2)*p%bb(:,3)-p%uxb(:,3)*p%bb(:,2)),idiag_poynxmxy)
if (idiag_poynymxy/=0.or.idiag_poynzmxy/=0) then
tmp2(:,1)=0.
tmp2(:,2)=eta_total*p%jxb(:,2)-mu01*(p%uxb(:,3)*p%bb(:,1)-p%uxb(:,1)*p%bb(:,3))
tmp2(:,3)=eta_total*p%jxb(:,3)-mu01*(p%uxb(:,1)*p%bb(:,2)-p%uxb(:,2)*p%bb(:,1))
call zsum_mn_name_xy(tmp2,idiag_poynymxy,(/0,1,0/))
call zsum_mn_name_xy(tmp2,idiag_poynzmxy,(/0,0,1/))
endif
call zsum_mn_name_xy(eta_total,idiag_etatotalmxy)
endif
call zsum_mn_name_xy(p%beta1,idiag_beta1mxy)
!
! Stokes parameters correct for Yin-Yang?
!
call zsum_mn_name_xy(p%StokesI,idiag_StokesImxy)
call zsum_mn_name_xy(p%StokesQ,idiag_StokesQmxy)
call zsum_mn_name_xy(p%StokesU,idiag_StokesUmxy)
call zsum_mn_name_xy(p%StokesQ1,idiag_StokesQ1mxy)
call zsum_mn_name_xy(p%StokesU1,idiag_StokesU1mxy)
call zsum_mn_name_xy(p%bb,idiag_bxbymxy,(/1,1,0/))
call zsum_mn_name_xy(p%bb,idiag_bxbzmxy,(/1,0,1/))
call zsum_mn_name_xy(p%bb,idiag_bybzmxy,(/0,1,1/))
!
if (idiag_bxbymxz/=0) call ysum_mn_name_xz(p%bb(:,1)*p%bb(:,2),idiag_bxbymxz)
if (idiag_bxbzmxz/=0) call ysum_mn_name_xz(p%bb(:,1)*p%bb(:,3),idiag_bxbzmxz)
if (idiag_bybzmxz/=0) call ysum_mn_name_xz(p%bb(:,2)*p%bb(:,3),idiag_bybzmxz)
if (idiag_uybxmxz/=0) call ysum_mn_name_xz(p%uu(:,2)*p%bb(:,1),idiag_uybxmxz)
if (idiag_uybzmxz/=0) call ysum_mn_name_xz(p%uu(:,2)*p%bb(:,3),idiag_uybzmxz)
call ysum_mn_name_xz(p%uxb(:,1),idiag_Exmxz)
call ysum_mn_name_xz(p%uxb(:,2),idiag_Eymxz)
call ysum_mn_name_xz(p%uxb(:,3),idiag_Ezmxz)
call ysum_mn_name_xz(p%va2,idiag_vAmxz)
else !MR: Why else?
!
! idiag_bxmxy and idiag_bymxy also need to be calculated when
! ldiagnos and idiag_bmx and/or idiag_bmy, so
!
! We may need to calculate bxmxy without calculating bmx. The following
! if condition was messing up calculation of bmxy_rms
!
if (ldiagnos) then
call zsum_mn_name_xy(p%bb(:,1),idiag_bxmxy)
call zsum_mn_name_xy(p%bb,idiag_bymxy,(/0,1,0/))
call zsum_mn_name_xy(p%bb,idiag_bzmxy,(/0,0,1/))
call zsum_mn_name_xy(p%jj(:,1),idiag_jxmxy)
call zsum_mn_name_xy(p%jj,idiag_jymxy,(/0,1,0/))
call zsum_mn_name_xy(p%jj,idiag_jzmxy,(/0,0,1/))
endif
endif
endsubroutine calc_2d_diagnostics_magnetic
!***********************************************************************
subroutine time_integrals_magnetic(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 magnetic
! 21-may-21/alberto: possibility of ltime_integrals_always=F to compute <b(t,x).b(t0,x)> adapted from hydro
! 2-jul-21/hongzhe: possibility of resetting bbt every dtcor time
!
real, dimension (mx,my,mz,mfarray) :: f
type (pencil_case) :: p
!
intent(inout) :: f
intent(in) :: p
integer :: ikx, nshear, iky
logical :: lreset_vart=.false.
!
! reset bbt etc. if lreset_vart=.true.
!
if (ltime_integrals_always .or. nint(dtcor)<=0.) then
if (it==1) lreset_vart=.true.
else
if (mod(nint(t),nint(dtcor))==1) lreset_vart=.true.
endif
!
! assign values to bbt etc.
!
if (ltime_integrals_always) then
if (lreset_vart) then
if (ibbt/=0) f(l1:l2,m,n,ibxt:ibzt) = 0.
if (ijjt/=0) f(l1:l2,m,n,ijxt:ijzt) = 0.
else
if (ibbt/=0) f(l1:l2,m,n,ibxt:ibzt) = f(l1:l2,m,n,ibxt:ibzt) +dt*p%bb
if (ijjt/=0) f(l1:l2,m,n,ijxt:ijzt) = f(l1:l2,m,n,ijxt:ijzt) +dt*p%jj
endif
elseif (lreset_vart) then
if (lvart_in_shear_frame) then
!
! store ibbt etc. in the shear frame
!
do ikx=l1,l2
nshear=nint( deltay/dy * x(ikx)/Lx )
iky=mod(m-nshear,ny)
if (iky<=0) iky=iky+ny
if (ibxt/=0 .and. ibx/=0) f(ikx,m,n,ibxt:ibzt) = f(ikx,iky,n,ibx:ibz)
if (ijxt/=0 .and. ijx/=0) f(ikx,m,n,ijxt:ijzt) = f(ikx,iky,n,ijx:ijz)
enddo
else
if (ibxt/=0 .and. ibx/=0) f(l1:l2,m,n,ibxt:ibzt) = f(l1:l2,m,n,ibx:ibz)
if (ijxt/=0 .and. ijx/=0) f(l1:l2,m,n,ijxt:ijzt) = f(l1:l2,m,n,ijx:ijz)
endif
endif
lreset_vart=.false.
!
endsubroutine time_integrals_magnetic
!***********************************************************************
subroutine df_diagnos_magnetic(df,p)
!
! calculate diagnostics that involves df
! Here we calculate <du/dt x b> and <u x db/dt>.
! The latter is calculated as <divu dai/dt> - <uji daj/dt>
! This is used in dynamo theory for checking the minimal tau approximation.
!
! 10-oct-06/axel: coded
!
use Diagnostics, only: sum_mn_name
use Sub
!
real, dimension (mx,my,mz,mvar) :: df
type (pencil_case) :: p
!
real, dimension (nx,3) :: uudot,aadot,udotxb,B1_gradu
real, dimension (nx) :: B1dot_udotxb,B1dot_uxbdot,B1dot_aadot,uxbdot2
!
intent(in) :: df, p
!
! this routine is only called when ldiagnos=T
! start with <du/dt x b>
!
if (idiag_udotxbm/=0) then
uudot=df(l1:l2,m,n,iux:iuz)
call cross_mn(uudot,p%bb,udotxb)
call dot_mn_sv(B1_ext,udotxb,B1dot_udotxb)
call sum_mn_name(B1dot_udotxb,idiag_udotxbm)
endif
!
! next, do <divu dai/dt> - <uji daj/dt>
!
if (idiag_uxbdotm/=0) then
aadot=df(l1:l2,m,n,iax:iaz)
call dot_mn_sv(B1_ext,aadot,B1dot_aadot)
call dot_mn_sm(B1_ext,p%uij,B1_gradu)
call dot_mn(B1_gradu,aadot,uxbdot2)
B1dot_uxbdot=p%divu*B1dot_aadot-uxbdot2
call sum_mn_name(B1dot_uxbdot,idiag_uxbdotm)
endif
!
endsubroutine df_diagnos_magnetic
!***********************************************************************
subroutine magnetic_after_boundary(f)
!
! 2-jan-10/axel: adapted from hydro_after_boundary
! 10-jan-13/MR: added possibility to remove evolving mean field
! 15-oct-15/MR: changes for slope-limited diffusion
! 7-jun-16/MR: modifications in z average removal for Yin-Yang, yet incomplete
! 03-apr-20/joern: restructured and fixed slope-limited diffusion, now in daa_dt
! 20-oct-21/MR: moved averages/removal to magetic_before_boundary
!
use Boundcond, only: update_ghosts
use Diagnostics, only: save_name
use Sub, only: div, calc_all_diff_fluxes, dot2_mn, vecout_initialize
!
real, dimension(mx,my,mz,mfarray), intent(inout) :: f
real, dimension(nx) :: tmp
real, save :: phase_beltrami_before=impossible
!
! Slope limited diffusion following Rempel (2014)
! First calculating the flux in a subroutine below
! using a slope limiting procedure then storing in the
! auxilaries variables in the f array (done above).
!
!SLD if (lmagnetic_slope_limited.and.llast) then
!
!SLD f(:,:,:,iFF_diff1:iFF_diff2)=0.
!
!SLD do j=1,3
!SLD call calc_all_diff_fluxes(f,iaa+j-1,islope_limiter,h_slope_limited)
!SLD do n=n1,n2; do m=m1,m2
!SLD call div(f,iFF_diff,f(l1:l2,m,n,iFF_div_aa+j-1),.true.)
!SLD enddo; enddo
!SLD enddo
!SLD endif
!
! Compute eta_smag and put into auxilliary variable
!
if (letasmag_as_aux) then
if (ljj_as_aux) then
do n=n1,n2; do m=m1,m2
!
call dot2_mn(f(l1:l2,m,n,ijx:ijz),tmp)
f(l1:l2,m,n,ietasmag)=(D_smag*dxmax)**2.*sqrt(tmp)
!
enddo; enddo
!
call update_ghosts(f,ietasmag) !MR: can this be avoided (do earlier)?
!
endif
endif
!
! Decide whether or not we want to override the use of the displacement current.
!
if (loverride_ee_decide) then
if (eta_tdep<eta_tdep_loverride_ee) then
loverride_ee=.true.
else
loverride_ee=.false.
endif
endif
!
! Output kx_aa for calculating k_effective.
!
if (lroot.and.ldiagnos) call save_name(kx_aa(1),idiag_kx_aa)
!
! if (lmagn_mf) call magnetic_after_boundary
!
! If phase_beltrami is finite,
! recalculate sinz and cosz for the phase correction of an
! imposed Beltrami field.
!
if (lforcing_cont_aa_local.and.iforcing_continuous_aa=='Beltrami-z') then
if (phase_beltrami/=phase_beltrami_before) then
phase_beltrami_before=phase_beltrami
sinz=sin(k1_ff_mag*z+phase_beltrami)
cosz=cos(k1_ff_mag*z+phase_beltrami)
endif
endif
!
if (ldiagnos.and.bthresh_per_brms/=0) call vecout_initialize(41,trim(directory)//'/bvec',nbvec)
endsubroutine magnetic_after_boundary
!***********************************************************************
subroutine set_border_magnetic(f,df,p)
!
! Calculates the driving term for the border profile
! of the aa 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
!
! select for different target profiles
!
do j=1,3
!
select case (borderaa(j))
!
case ('zero','0')
f_target(:,j)=0.
call border_driving(f,df,p,f_target(:,j),iaa+j-1)
!
case ('initial-condition')
call set_border_initcond(f,iaa+j-1,f_target(:,j))
call border_driving(f,df,p,f_target(:,j),iaa+j-1)
!
case ('nothing')
endselect
enddo
!
endsubroutine set_border_magnetic
!***********************************************************************
subroutine magnetic_calc_spectra(f,spectrum,spectrum_hel,lfirstcall,kind)
!
! Calculates magnetic spectra. For use with a single magnetic module.
!
! 16-apr-21/axel: adapted from gravitational_waves_hTXk.f90
!
real, dimension (mx,my,mz,mfarray) :: f
real, dimension (:) :: spectrum,spectrum_hel
logical :: lfirstcall
character(LEN=3) :: kind
!
call fatal_error("magnetic_calc_spectra","impossible: iaakim=0, ieekim=0")
!
call keep_compiler_quiet(f)
call keep_compiler_quiet(spectrum,spectrum_hel)
call keep_compiler_quiet(lfirstcall)
call keep_compiler_quiet(kind)
!
endsubroutine magnetic_calc_spectra
!***********************************************************************
subroutine eta_shell(p,eta_mn,geta)
!
! 24-nov-03/dave: coded
! 23-jun-09/axel: generalized to lcylinder_in_a_box
!
use Sub, only: step, der_step
!
type (pencil_case) :: p
real, dimension (nx) :: eta_mn
real, dimension (nx) :: prof,eta_r
real, dimension (nx,3) :: geta
real :: d_int,d_ext
!
eta_r=0.
!
if (eta_int > 0.) then
d_int = eta_int - eta
else
d_int = 0.
endif
if (eta_ext > 0.) then
d_ext = eta_ext - eta
else
d_ext = 0.
endif
!
! calculate steps in resistivity
! make this dependent on the geometry used
!
! (i) lcylinder_in_a_box
!
if (lcylinder_in_a_box.or.lcylindrical_coords) then
prof=step(p%rcyl_mn,r_int,wresistivity)
eta_mn=d_int*(1-prof)
prof=step(p%rcyl_mn,r_ext,wresistivity)
eta_mn=eta+eta_mn+d_ext*prof
!
! calculate radial derivative of steps and gradient of eta
!
prof=der_step(p%rcyl_mn,r_int,wresistivity)
eta_r=-d_int*prof
prof=der_step(p%rcyl_mn,r_ext,wresistivity)
eta_r=eta_r+d_ext*prof
geta=p%evr*spread(eta_r,2,3)
!
! (ii) lsphere_in_a_box
!
elseif (lsphere_in_a_box.or.lspherical_coords) then
prof=step(p%r_mn,r_int,wresistivity)
eta_mn=d_int*(1-prof)
prof=step(p%r_mn,r_ext,wresistivity)
eta_mn=eta+eta_mn+d_ext*prof
!
! calculate radial derivative of steps and gradient of eta
!
prof=der_step(p%r_mn,r_int,wresistivity)
eta_r=-d_int*prof
prof=der_step(p%r_mn,r_ext,wresistivity)
eta_r=eta_r+d_ext*prof
geta=p%evr*spread(eta_r,2,3)
!
! (iii) other cases are not implemented yet
!
else
call not_implemented("eta_shell","for others than spheres or cylinders (possibly in a box)")
endif
!
endsubroutine eta_shell
!***********************************************************************
subroutine calc_bthresh
!
! calculate bthresh from brms, give warnings if there are problems
! needs to be called after calc_mfield.
!
! 6-aug-03/axel: coded
!
use Mpicomm, only: mpibcast_real, MPI_COMM_WORLD
real :: brms
!
! fetch brms (this requires that brms is set in print.in)
! broadcast result to other processors
!
if (lroot) brms=fname(idiag_brms)
call mpibcast_real(brms,comm=MPI_COMM_WORLD)
!
! if nvec exceeds nbvecmax (=1/4) of points per processor, then begin to
! increase scaling factor on bthresh. These settings will stay in place
! until the next restart
!
if (nbvec>nbvecmax) then
print*,'calc_bthresh: processor ',iproc_world,': bthresh_scl,nbvec,nbvecmax=', &
bthresh_scl,nbvec,nbvecmax
bthresh_scl=bthresh_scl*1.2
endif
!
! calculate bthresh as a certain fraction of brms
!
bthresh=bthresh_scl*bthresh_per_brms*brms
!
endsubroutine calc_bthresh
!***********************************************************************
subroutine rescaling_magnetic(f)
!
! Rescale magnetic field by factor rescale_aa,
!
! 22-feb-05/axel: coded
! 10-feb-09/petri: adapted from testfield
!
use Sub, only: update_snaptime, read_snaptime
!
real, dimension (mx,my,mz,mfarray) :: f
character (len=fnlen) :: file
logical :: lmagnetic_out
logical, save :: lfirst_call=.true.
!
intent(inout) :: f
!
! Reinitialize aa periodically if requested
!
if (lreset_aa) then
file=trim(datadir)//'/treset_aa.dat'
if (lfirst_call) then
call read_snaptime(trim(file),taareset,naareset,daareset,t)
if (taareset==0 .or. taareset < t-daareset) then
taareset=t+daareset
endif
lfirst_call=.false.
endif
!
! Rescale when the time has come
! (Note that lmagnetic_out and ch are not used here)
!
if (t >= taareset) then
f(:,:,:,iax:iaz)=rescale_aa*f(:,:,:,iax:iaz)
call update_snaptime(file,taareset,naareset,daareset,t,lmagnetic_out)
endif
endif
!
endsubroutine rescaling_magnetic
!***********************************************************************
subroutine calc_tau_aa_exterior(f,df)
!
! magnetic field relaxation to zero on time scale tau_aa_exterior within
! exterior region. For the time being this means z > zgrav.
!
! 29-jul-02/axel: coded
!
use Gravity, only: zgrav
!
real, dimension (mx,my,mz,mfarray) :: f
real, dimension (mx,my,mz,mvar) :: df
real :: scl
integer :: j
!
intent(in) :: f
intent(inout) :: df
!
if (headtt) print*,'calc_tau_aa_exterior: tau=',tau_aa_exterior
if (z(n)>zgrav) then
scl=1./tau_aa_exterior
do j=iax,iaz
df(l1:l2,m,n,j)=df(l1:l2,m,n,j)-scl*f(l1:l2,m,n,j)
enddo
endif
!
endsubroutine calc_tau_aa_exterior
!***********************************************************************
subroutine helflux(aa,uxb,jj)
!
! magnetic helicity flux (preliminary)
!
! 14-aug-03/axel: coded
!
use Diagnostics
!
real, dimension (nx,3), intent(in) :: aa,uxb,jj
real, dimension (nx,3) :: ee
real, dimension (nx) :: FHx,FHz
real :: FH
!
ee=eta*jj-uxb
!
! calculate magnetic helicity flux in the X and Z directions
!
FHx=-2*ee(:,3)*aa(:,2)*dsurfyz
FHz=+2*ee(:,1)*aa(:,2)*dsurfxy
!
! sum up contribution per pencil
! and then stuff result into surf_mn_name for summing up all processors.
!
FH=FHx(nx)-FHx(1)
if (lfirst_proc_z) then
if (n==n1) FH=FH-sum(FHz)
call surf_mn_name(FH,idiag_exaym2,n1)
endif
if (llast_proc_z) then
if (n==n2) FH=FH+sum(FHz)
call surf_mn_name(FH,idiag_exaym2,n2)
endif
!
endsubroutine helflux
!***********************************************************************
subroutine curflux_dS(uxb,jj)
!
! current helicity flux (preliminary)
!
! 27-nov-03/axel: adapted from helflux
!
use Diagnostics
!
real, dimension (nx,3), intent(in) :: uxb,jj
real, dimension (nx,3) :: ee
real, dimension (nx) :: FCx,FCz
real :: FC
!
ee=eta*jj-uxb
!
! calculate current helicity flux in the X and Z directions
! Could speed up by only calculating here boundary points!
!
FCx=2*(ee(:,2)*jj(:,3)-ee(:,3)*jj(:,2))*dsurfyz
FCz=2*(ee(:,1)*jj(:,2)-ee(:,2)*jj(:,1))*dsurfxy
!
! sum up contribution per pencil
! and then stuff result into surf_mn_name for summing up all processors.
!
FC=FCx(nx)-FCx(1)
if (lfirst_proc_z) then
if (n==n1) FC=FC-sum(FCz)
call surf_mn_name(FC,idiag_exjm2,n1)
endif
if (llast_proc_z) then
if (n==n2) FC=FC+sum(FCz)
call surf_mn_name(FC,idiag_exjm2,n2)
endif
!
endsubroutine curflux_dS
!***********************************************************************
subroutine curflux(uxb,jj)
!
! current helicity flux (preliminary)
!
! 27-nov-03/axel: adapted from helflux
!
use Diagnostics
!
real, dimension (nx,3), intent(in) :: uxb,jj
real, dimension (nx,3) :: ee
real, dimension (nx) :: FCz
!
ee=eta*jj-uxb
!
! calculate current helicity flux in the Z direction
! exj = e1*j2 - e2*j1
!
FCz=2*(ee(:,1)*jj(:,2)-ee(:,2)*jj(:,1))
call sum_mn_name(FCz,idiag_exjm2)
!
endsubroutine curflux
!***********************************************************************
subroutine read_magnetic_init_pars(iostat)
!
use File_io, only: parallel_unit
!
integer, intent(out) :: iostat
!
read(parallel_unit, NML=magnetic_init_pars, IOSTAT=iostat)
!
! read namelist for mean-field theory (if invoked)
!
if (lmagn_mf) call read_magn_mf_init_pars(iostat)
!
endsubroutine read_magnetic_init_pars
!***********************************************************************
subroutine write_magnetic_init_pars(unit)
!
integer, intent(in) :: unit
!
write(unit, NML=magnetic_init_pars)
!
! write namelist for mean-field theory (if invoked)
!
if (lmagn_mf) call write_magn_mf_init_pars(unit)
!
endsubroutine write_magnetic_init_pars
!***********************************************************************
subroutine read_magnetic_run_pars(iostat)
!
use File_io, only: parallel_unit
!
integer, intent(out) :: iostat
!
read(parallel_unit, NML=magnetic_run_pars, IOSTAT=iostat)
!
! read namelist for mean-field theory (if invoked)
!
if (lmagn_mf) call read_magn_mf_run_pars(iostat)
!
endsubroutine read_magnetic_run_pars
!***********************************************************************
subroutine write_magnetic_run_pars(unit)
!
integer, intent(in) :: unit
!
write(unit, NML=magnetic_run_pars)
!
! write namelist for mean-field theory (if invoked)
!
if (lmagn_mf) call write_magn_mf_run_pars(unit)
!
endsubroutine write_magnetic_run_pars
!***********************************************************************
subroutine forcing_continuous(df,p)
!
! add a continuous forcing term (here currently only for localized rotors)
!
! 21-jan-07/axel: adapted from hydro
! 24-feb-09/axel: calls to this routine are now replaced by adding p$fcont
!
use Diagnostics
use Mpicomm, only: mpibcast_real
use Sub
!
real, dimension (mx,my,mz,mvar) :: df
type (pencil_case) :: p
real, dimension (nx) :: phi
real :: fact
!
! calculate forcing
!
if (iforcing_continuous_aa=='fixed_swirl') then
fact=ampl_ff
phi=2.*R12*fact*phix(l1:l2)*phiy(m)*phiz(n)
forcing_rhs(:,1)=(-swirl*y(m )+2.*x(l1:l2)*z(n))*phi
forcing_rhs(:,2)=(+swirl*x(l1:l2)+2.*y(m )*z(n))*phi
forcing_rhs(:,3)=(R2-x(l1:l2)**2-y(m)**2)*2.*R12*phi
elseif (iforcing_continuous_aa=='cosxcosz') then
fact=ampl_ff
forcing_rhs(:,1)=0.
forcing_rhs(:,2)=fact*cosx(l1:l2)*cosz(n)
forcing_rhs(:,3)=0.
elseif (iforcing_continuous_aa=='Azsinx') then
fact=ampl_ff
forcing_rhs(:,1)=0.
forcing_rhs(:,2)=0.
forcing_rhs(:,3)=fact*sinx(l1:l2)
elseif (iforcing_continuous_aa=='Aycosz') then
fact=ampl_ff
forcing_rhs(:,1)=0.
forcing_rhs(:,2)=fact*cosz(n)
forcing_rhs(:,3)=0.
elseif (iforcing_continuous_aa=='RobertsFlow') then
fact=ampl_ff
forcing_rhs(:,1)=-fact*cosx(l1:l2)*siny(m)
forcing_rhs(:,2)=+fact*sinx(l1:l2)*cosy(m)
forcing_rhs(:,3)=+fact*cosx(l1:l2)*cosy(m)*sqrt(2.)
elseif (iforcing_continuous_aa=='Beltrami-z') then
fact=-eta*k1_ff_mag*ampl_beltrami
forcing_rhs(:,1)=fact*cosz(n)
forcing_rhs(:,2)=fact*sinz(n)
forcing_rhs(:,3)=0.
endif
!
! apply forcing in uncurled induction equation
!
df(l1:l2,m,n,iax:iaz)=df(l1:l2,m,n,iax:iaz)+forcing_rhs
!
endsubroutine forcing_continuous
!***********************************************************************
subroutine get_slices_magnetic(f,slices)
!
! Write slices for animation of Magnetic variables.
!
! 26-jul-06/tony: coded
! 14-apr-16/MR: changes for Yin-Yang
!
use General, only: transform_thph_yy_other
use Slices_methods, only: assign_slices_vec, assign_slices_scal
real, dimension (mx,my,mz,mfarray) :: f
type (slice_data) :: slices
!
! Loop over slices
!
select case (trim(slices%name))
!
! Magnetic vector potential (code variable)
!
case ('aa')
call assign_slices_vec(slices,f,iaa)
!
! Phi component of magnetic vector potential times axis distance (derived variable)
!
case ('aps')
call assign_slices_scal(slices,aps_xy,aps_xz,aps_yz,xz2=aps_xz2)
!
! Magnetic field (derived variable)
!
case ('bb')
call assign_slices_vec(slices,bb_xy,bb_xz,bb_yz,bb_xy2,bb_xy3,bb_xy4,bb_xz2,bb_r)
!
! Current density (derived variable)
!
case ('jj')
call assign_slices_vec(slices,jj_xy,jj_xz,jj_yz,jj_xy2,jj_xy3,jj_xy4,jj_xz2,jj_r)
!
! Magnetic field squared (derived variable)
!
case ('b2')
call assign_slices_scal(slices,b2_xy,b2_xz,b2_yz,b2_xy2,b2_xy3,b2_xy4,b2_xz2,b2_r)
!
! Current squared (derived variable)
!
case ('j2')
call assign_slices_scal(slices,j2_xy,j2_xz,j2_yz,j2_xy2,j2_xy3,j2_xy4,j2_xz2,j2_r)
!
! Magnetic field in spherical coordinates (derived variable)
!
case ('bb_sph')
call assign_slices_vec(slices,bb_sph_xy,bb_sph_xz,bb_sph_yz, &
bb_sph_xy2,bb_sph_xy3,bb_sph_xy4,bb_sph_xz2,bb_sph_r)
!
! Current density times magnetic field (derived variable)
!
case ('jb')
call assign_slices_scal(slices,jb_xy,jb_xz,jb_yz,jb_xy2,jb_xy3,jb_xy4,jb_xz2,jb_r)
!
! Plasma beta
!
case ('beta1','beta')
call assign_slices_scal(slices,beta1_xy,beta1_xz,beta1_yz,beta1_xy2,beta1_xy3,&
beta1_xy4,beta1_xz2,beta1_r)
!
! Poynting vector
!
case ('poynting')
call assign_slices_vec(slices,poynting_xy,poynting_xz,poynting_yz,poynting_xy2,&
poynting_xy3,poynting_xy4,poynting_xz2,poynting_r)
!
! Magnetic helicity density
!
case ('ab')
call assign_slices_scal(slices,ab_xy,ab_xz,ab_yz,ab_xy2,ab_xy3,ab_xy4,ab_xz2,ab_r)
!
endselect
!
endsubroutine get_slices_magnetic
!***********************************************************************
subroutine calc_mfield
!
! calculate mean magnetic field from xy- or z-averages
!
! 19-jun-02/axel: moved from print to here
! 9-nov-02/axel: corrected bxmy(m,j); it used bzmy instead!
!
! The following calculation involving spatial averages
!
use Mpicomm, only: mpibcast_real,MPI_COMM_WORLD
use Diagnostics, only: save_name
!
if (idiag_bmx/=0) call calc_bmx
if (idiag_bmy/=0) call calc_bmy
if (idiag_bmz/=0) call calc_bmz
if (idiag_bmzS2/=0) call calc_bmzS2
if (idiag_bmzA2/=0) call calc_bmzA2
if (idiag_jmx/=0) call calc_jmx
if (idiag_jmy/=0) call calc_jmy
if (idiag_jmz/=0) call calc_jmz
if (idiag_emxamz3/=0) call calc_emxamz3
if (idiag_embmz/=0) call calc_embmz
if (idiag_ambmz/=0) call calc_ambmz
if (idiag_ambmzh/=0) call calc_ambmzh
if (idiag_jmbmz/=0.or.idiag_kmz/=0) call calc_jmbmz
if (idiag_bmxy_rms/=0) call calc_bmxy_rms
if (idiag_bmzph/=0) call calc_bmz_beltrami_phase
!
! Set the phase of the Beltrami forcing equal to the actual phase
! of the magnetic field (times forcing_continuous_aa_phasefact).
!
phase_beltrami=forcing_continuous_aa_phasefact*bmz_beltrami_phase
!
! set amplitude to ampl_ff minus a correction term that is
! proportional to the actual field minus the target field strength,
! scaled by some forcing_continuous_aa_amplfact, and broadcast, ie
! A = Atarget - factor*(Aactual-Atarget).
!
ampl_beltrami=ampl_ff-forcing_continuous_aa_amplfact*(bmz-ampl_ff)
call mpibcast_real(ampl_beltrami)
!
! Integral over magnetic spectra.
!
if (ldiagnos) then
call save_name(km0EM,idiag_km0EM)
call save_name(km1EM,idiag_km1EM)
endif
!
endsubroutine calc_mfield
!***********************************************************************
subroutine calc_bmx
!
! Magnetic energy in the yz-averaged field. The bymxy and bzmxy must have
! been calculated, so they are present on the z-root processors.
!
! 6-apr-08/axel: moved from calc_mfield to here
! 26-aug-09/anders: used mpireduce_sum to remove need for nyproc arrays
!
use Diagnostics
use Mpicomm
!
logical,save :: first=.true.
real, dimension(nx) :: bymx, bzmx, bmx2
real, dimension(nx,ny) :: fsumxy
real :: bmx
!
! This only works if bymxy and bzmxy are in zaver.in, so warning if this is not ok.
!
if (idiag_bymxy==0.or.idiag_bzmxy==0) then
if (first) &
call warning("calc_bmx","to get bmx, set bymxy and bzmxy in 'zaver.in'."// &
achar(10)//'We proceed, but you will get bmx=0')
bmx2=0.0
else
if (lfirst_proc_z) then
call mpireduce_sum(fnamexy(idiag_bymxy,:,:),fsumxy,(/nx,ny/),idir=IYBEAM)
bymx=sum(fsumxy,dim=2)/nygrid
call mpireduce_sum(fnamexy(idiag_bzmxy,:,:),fsumxy,(/nx,ny/),idir=IXBEAM)
bzmx=sum(fsumxy,dim=2)/nygrid
endif
if (lfirst_proc_yz) call mpireduce_sum(bymx**2+bzmx**2,bmx2,nx,idir=IXBEAM)
endif
!
! Save the name in the idiag_bmx slot and set first to false.
! Compute final result only on the root processor.
! This is not current working with x-parallelization!
!
if (lroot) then
bmx=sqrt(sum(bmx2)/nxgrid)
call save_name(bmx,idiag_bmx)
endif
first=.false.
!
endsubroutine calc_bmx
!***********************************************************************
subroutine calc_bmy
!
! Magnetic energy in the xz-averaged field. The bxmxy and bzmxy must have
! been calculated, so they are present on the z-root processors.
!
! 6-apr-08/axel: moved from calc_mfield to here
! 26-aug-09/axel: adapted change of Anders to used mpireduce_sum
!
use Diagnostics
use Mpicomm
!
logical,save :: first=.true.
real, dimension(ny) :: bxmy, bzmy, bmy2
real, dimension(nx,ny) :: fsumxy
real :: bmy
!
! This only works if bxmxy and bzmxy are in zaver, so print warning if this is
! not ok.
!
if (idiag_bxmxy==0.or.idiag_bzmxy==0) then
if (first) &
call warning("calc_bmy","to get bmy, set bxmxy and bzmxy in 'zaver.in'."// &
achar(10)//'We proceed, but you will get bmy=0')
bmy2=0.0
else
if (lfirst_proc_z) then
call mpireduce_sum(fnamexy(idiag_bxmxy,:,:),fsumxy,(/nx,ny/),idir=IXBEAM)
bxmy=sum(fsumxy,dim=1)/nxgrid
call mpireduce_sum(fnamexy(idiag_bzmxy,:,:),fsumxy,(/nx,ny/),idir=IXBEAM)
bzmy=sum(fsumxy,dim=1)/nxgrid
endif
if (lfirst_proc_xz) call mpireduce_sum(bxmy**2+bzmy**2,bmy2,ny,idir=IYBEAM)
endif
!
! Save the name in the idiag_bmy slot and set first to false.
! Compute final result only on the root processor.
!
if (lroot) then
bmy=sqrt(sum(bmy2)/nygrid)
call save_name(bmy,idiag_bmy)
endif
first=.false.
!
endsubroutine calc_bmy
!***********************************************************************
subroutine calc_bmzS2
!
! Magnetic energy in anisymmetric part of the horizontally averaged field.
! The bxmz and bymz must have been calculated, and present on root processor.
!
! 8-mar-10/axel: adapted from bmz
!
use Diagnostics, only: save_name
!
logical,save :: first=.true.
integer :: n_reverse,ipz_reverse
real :: bxmS,bymS
!
! This only works if bxmz and bzmz are in xyaver, so print warning if this is
! not ok.
!
if (idiag_bxmz==0.or.idiag_bymz==0) then
if (first) &
call warning("calc_bmzS2","to get bmzS2, set bxmz and bymz in 'xyaver.in'."// &
achar(10)//'We proceed, but you will get bmzS2=0')
bxmS=0.
bymS=0.
else
bxmS=0.
bymS=0.
do n=1,nz
n_reverse=nz-n+1
ipz_reverse=ipz !(for now)
bxmS=bxmS+fnamez(n,ipz+1,idiag_bxmz)+fnamez(n_reverse,ipz_reverse+1,idiag_bxmz)
bymS=bymS+fnamez(n,ipz+1,idiag_bymz)+fnamez(n_reverse,ipz_reverse+1,idiag_bymz)
enddo
endif
!
! Save the name in the idiag_bmzS slot and set first to false.
!
call save_name((bxmS**2+bymS**2)/nz**2,idiag_bmzS2)
first=.false.
!
endsubroutine calc_bmzS2
!***********************************************************************
subroutine calc_bmzA2
!
! Magnetic energy in anisymmetric part of the horizontally averaged field.
! The bxmz and bymz must have been calculated, and present on root processor.
!
! 8-mar-10/axel: adapted from bmz
!
use Diagnostics, only: save_name
!
logical,save :: first=.true.
integer :: n_reverse,ipz_reverse
real :: bxmA,bymA
!
! This only works if bxmz and bzmz are in xyaver, so print warning if this is
! not ok.
!
if (idiag_bxmz==0.or.idiag_bymz==0) then
if (first) &
call warning("calc_bmzA2","to get bmzA2, set bxmz and bymz in 'xyaver.in'."// &
achar(10)//'We proceed, but you will get bmzA2=0')
bxmA=0.
bymA=0.
else
bxmA=0.
bymA=0.
do n=1,nz
n_reverse=nz-n+1
ipz_reverse=ipz !(for now)
bxmA=bxmA+fnamez(n,ipz+1,idiag_bxmz)-fnamez(n_reverse,ipz_reverse+1,idiag_bxmz)
bymA=bymA+fnamez(n,ipz+1,idiag_bymz)-fnamez(n_reverse,ipz_reverse+1,idiag_bymz)
enddo
endif
!
! Save the name in the idiag_bmzA slot and set first to false.
!
call save_name((bxmA**2+bymA**2)/nz**2,idiag_bmzA2)
first=.false.
!
endsubroutine calc_bmzA2
!***********************************************************************
subroutine calc_bmz
!
! Magnetic energy in horizontally averaged field. The bxmz and bymz must have
! been calculated, so they are present on the root processor.
!
! 6-apr-08/axel: moved from calc_mfield to here
!
use Diagnostics
!
logical,save :: first=.true.
!
! This only works if bxmz and bzmz are in xyaver, so print warning if this is
! not ok.
!
if (idiag_bxmz==0.or.idiag_bymz==0) then
if (first) &
call warning("calc_bmz","to get bmz, set bxmz and bymz in 'xyaver.in'."// &
achar(10)//'We proceed, but you will get bmz=0')
bmz=0.0
else
bmz=sqrt(sum(fnamez(:,:,idiag_bxmz)**2 &
+fnamez(:,:,idiag_bymz)**2)/(nz*nprocz))
endif
!
! Save the name in the idiag_bmz slot and set first to false.
!
call save_name(bmz,idiag_bmz)
first=.false.
!
endsubroutine calc_bmz
!***********************************************************************
subroutine calc_jmx
!
! Magnetic energy in the yz-averaged field. The jymxy and jzmxy must have
! been calculated, so they are present on the z-root processors.
!
! 6-apr-08/axel: moved from calc_mfield to here
! 28-feb-10/axel: final jmx can only be computed on root processor
!
use Diagnostics
use Mpicomm
!
logical,save :: first=.true.
real, dimension(nx) :: jymx,jzmx,jmx2
real, dimension(nx,ny) :: fsumxy
real :: jmx
!
! This only works if jymxy and jzmxy are in zaver, so print warning if this is
! not ok.
!
if (idiag_jymxy==0.or.idiag_jzmxy==0) then
if (first) &
call warning("calc_jmx","to get jmx, set jymxy and jzmxy in 'zaver.in'."// &
achar(10)//"We proceed, jut you'll get jmx=0")
jmx2=0.
else
if (lfirst_proc_z) then
call mpireduce_sum(fnamexy(idiag_jymxy,:,:),fsumxy,(/nx,ny/),idir=IYBEAM)
jymx=sum(fsumxy,dim=2)/nygrid
call mpireduce_sum(fnamexy(idiag_jzmxy,:,:),fsumxy,(/nx,ny/),idir=IYBEAM)
jzmx=sum(fsumxy,dim=2)/nygrid
endif
if (lfirst_proc_yz) call mpireduce_sum(jymx**2+jzmx**2,jmx2,nx,idir=IXBEAM)
endif
!
! Save the name in the idiag_jmx slot and set first to false.
! Compute final result only on the root processor.
!
if (lroot) then
jmx=sqrt(sum(jmx2)/nxgrid)
call save_name(jmx,idiag_jmx)
endif
first=.false.
!
endsubroutine calc_jmx
!***********************************************************************
subroutine calc_jmy
!
! Magnetic energy in the xz-averaged field. The jxmxy and jzmxy must have
! been calculated, so they are present on the z-root processors.
!
! 6-apr-08/axel: moved from calc_mfield to here
! 28-feb-10/axel: final jmy can only be computed on root processor
!
use Diagnostics
use Mpicomm
!
logical,save :: first=.true.
real, dimension(ny) :: jxmy,jzmy,jmy2
real, dimension(nx,ny) :: fsumxy
real :: jmy
!
! This only works if jxmxy and jzmxy are in zaver, so print warning if this is
! not ok.
!
if (idiag_jxmxy==0.or.idiag_jzmxy==0) then
if (first) &
call warning("calc_jmy","to get jmy, set jxmxy and jzmxy in 'zaver.in'."// &
achar(10)//"We proceed, but you'll get jmy=0")
jmy2=0.
else
if (lfirst_proc_z) then
call mpireduce_sum(fnamexy(idiag_jxmxy,:,:),fsumxy,(/nx,ny/),idir=IXBEAM)
jxmy=sum(fsumxy,dim=1)/nxgrid
call mpireduce_sum(fnamexy(idiag_jzmxy,:,:),fsumxy,(/nx,ny/),idir=IXBEAM)
jzmy=sum(fsumxy,dim=1)/nxgrid
endif
if (lfirst_proc_xz) call mpireduce_sum(jxmy**2+jzmy**2,jmy2,ny,idir=IYBEAM)
endif
!
! Save the name in the idiag_jmy slot and set first to false.
! Compute final result only on the root processor.
!
if (lroot) then
jmy=sqrt(sum(jmy2)/nygrid)
call save_name(jmy,idiag_jmy)
endif
first=.false.
!
endsubroutine calc_jmy
!***********************************************************************
subroutine calc_jmz
!
! Magnetic energy in horizontally averaged field. The jxmz and jymz must have
! been calculated, so they are present on the root processor.
!
! 6-apr-08/axel: moved from calc_mfield to here
!
use Diagnostics
!
logical,save :: first=.true.
real :: jmz
!
! This only works if jxmz and jzmz are in xyaver, so print warning if this is
! not ok.
!
if (idiag_jxmz==0.or.idiag_jymz==0) then
if (first) &
call warning("calc_jmz","to get jmz, set jxmz and jymz in 'xyaver.in'."// &
achar(10)//"We proceed, but you'll get jmz=0")
jmz=0.
else
jmz=sqrt(sum(fnamez(:,:,idiag_jxmz)**2 &
+fnamez(:,:,idiag_jymz)**2)/(nz*nprocz))
endif
!
! Save the name in the idiag_jmz slot and set first to false.
!
if (lroot) call save_name(jmz,idiag_jmz)
first=.false.
!
endsubroutine calc_jmz
!***********************************************************************
subroutine calc_embmz
!
! Magnetic helicity production of mean field. The bxmz and bymz as well as Exmz
! and Eymz must have been calculated, so they are present on the root
! processor.
!
! 6-apr-08/axel: moved from calc_mfield to here
!
use Diagnostics
!
logical,save :: first=.true.
real :: embmz
!
! This only works if bxmz and bzmz are in xyaver, so print warning if this is
! not ok.
!
if (idiag_Exmz==0.or.idiag_Eymz==0) then
if (first) &
call warning("calc_embmz","to get embmz, set bxmz, bymz, Exmz, and Eymz in 'xyaver.in'"// &
achar(10)//"We proceed, but you'll get embmz=0")
embmz=0.
else
embmz=sum(fnamez(:,:,idiag_bxmz)*fnamez(:,:,idiag_Exmz) &
+fnamez(:,:,idiag_bymz)*fnamez(:,:,idiag_Eymz))/(nz*nprocz)
endif
!
! Save the name in the idiag_embmz slot and set first to false.
!
if (lroot) call save_name(embmz,idiag_embmz)
first=.false.
!
endsubroutine calc_embmz
!***********************************************************************
subroutine calc_emxamz3
!
! Volume average of magnetic helicity flux of the mean field. The axmz and
! aymz as well as Exmz and Eymz must have been calculated, so they are present
! on the root processor.
!
! 6-apr-08/axel: moved from calc_mfield to here
!
use Diagnostics
!
logical,save :: first=.true.
real :: emxamz3
!
! This only works if bxmz and bzmz are in xyaver, so print warning if this is
! not ok.
!
if (idiag_Exmz==0.or.idiag_Eymz==0.or. &
idiag_axmz==0.or.idiag_aymz==0) then
if (first) &
call warning("calc_emxamz3","to get emxamz3, set axmz, aymz, Exmz, and Eymz in 'xyaver.in'."// &
achar(10)//"We proceed, but you'll get emxamz3=0")
emxamz3=0.
else
emxamz3=sum(fnamez(:,:,idiag_Exmz)*fnamez(:,:,idiag_aymz) &
-fnamez(:,:,idiag_Eymz)*fnamez(:,:,idiag_axmz))/(nz*nprocz)
endif
!
! Save the name in the idiag_emxamz3 slot and set first to false.
!
if (lroot) call save_name(emxamz3,idiag_emxamz3)
first=.false.
!
endsubroutine calc_emxamz3
!***********************************************************************
subroutine calc_ambmz
!
! Magnetic helicity of the xy-averaged mean field. The bxmz and bymz as well as
! axmz and aymz must have been calculated, so they are present on the root
! processor.
!
! 16-may-09/axel: adapted from calc_jmbmz
!
use Diagnostics
!
logical,save :: first=.true.
real :: ambmz
!
! This only works if bxmz and bzmz are in xyaver, so print warning if this is
! not ok.
!
if (idiag_axmz==0.or.idiag_aymz==0) then
if (first) &
call warning("calc_ambmz","to get ambmz, set bxmz, bymz, axmz, and aymz in 'xyaver.in'."// &
achar(10)//"We proceed, but you'll get ambmz=0")
ambmz=0.
else
ambmz=sum(fnamez(:,:,idiag_bxmz)*fnamez(:,:,idiag_axmz) &
+fnamez(:,:,idiag_bymz)*fnamez(:,:,idiag_aymz))/(nz*nprocz)
endif
!
! Save the name in the idiag_ambmz slot and set first to false.
!
if (lroot) call save_name(ambmz,idiag_ambmz)
first=.false.
!
endsubroutine calc_ambmz
!***********************************************************************
subroutine calc_ambmzh
!
! Hemispheric magnetic helicity of the xy-averaged mean field. The bxmz and
! bymz as well as axmz and aymz must have been calculated, so they are present
! on the root processor.
!
! 16-may-09/axel: adapted from calc_ambmz
!
use Diagnostics
!
logical,save :: first=.true.
real, dimension(2) :: ambmzh
real :: ambmz_tmp,fact
integer :: iprocz
!
! initialize ambmzh to zero each time, because its two elements
! are integration counters. If idiag_axmz etc are not set, the
! routine escapes, but even then it needs to be initialized.
!
ambmzh=0.
!
! This only works if bxmz and bzmz are in xyaver,
! so print warning if this is not ok.
! Loop over all processors, but don't use (overwrite) ipz for that
!
if (idiag_axmz==0.or.idiag_aymz==0) then
if (first) &
call warning("calc_ambmzh","to get ambmzh, set bxmz, bymz, axmz, and aymz in 'xyaver.in'"// &
achar(10)//"We proceed, but you'll get ambmzh=0")
else
fact=1./(nz*nprocz)
do n=1,nz
do iprocz=1,nprocz
ambmz_tmp=fact*( fnamez(n,iprocz,idiag_bxmz)*fnamez(n,iprocz,idiag_axmz) &
+fnamez(n,iprocz,idiag_bymz)*fnamez(n,iprocz,idiag_aymz))
if (z_allprocs(n,iprocz)>=zequator) then
ambmzh(2)=ambmzh(2)+ambmz_tmp
else
ambmzh(1)=ambmzh(1)+ambmz_tmp
endif
enddo
enddo
endif
!
! North means 1 and south means 2.
! save the name in the idiag_ambmz slot
! and set first to false
!
if (lroot) call save_name_halfz(ambmzh,idiag_ambmzh)
fname(idiag_ambmzn)=fname_half(idiag_ambmzh,1)
fname(idiag_ambmzs)=fname_half(idiag_ambmzh,2)
itype_name(idiag_ambmzn)=ilabel_save
itype_name(idiag_ambmzs)=ilabel_save
first=.false.
!
endsubroutine calc_ambmzh
!***********************************************************************
subroutine calc_jmbmz
!
! Current helicity of the xy-averaged mean field
! The bxmz and bymz as well as jxmz and jymz must have been calculated,
! so they are present on the root processor.
!
! 21-apr-08/axel: adapted from calc_embmz
!
use Diagnostics
!
logical,save :: first=.true.
real :: jmbmz
!
! This only works if bxmz and bzmz are in xyaver, so print warning if this is
! not ok.
!
if (idiag_jxmz==0.or.idiag_jymz==0) then
if (first) &
call warning("calc_jmbmz","to get jmbmz, set bxmz, bymz, jxmz, and jymz in 'xyaver.in'."// &
achar(10)//"We proceed, but you'll get jmbmz=0")
jmbmz=0.
else
jmbmz=sum(fnamez(:,:,idiag_bxmz)*fnamez(:,:,idiag_jxmz) &
+fnamez(:,:,idiag_bymz)*fnamez(:,:,idiag_jymz))/(nz*nprocz)
endif
!
! Save the name in the idiag_jmbmz slot and set first to false.
!
if (lroot) then
if (idiag_jmbmz/=0) call save_name(jmbmz,idiag_jmbmz)
if (idiag_kmz/=0) call save_name(jmbmz/bmz**2,idiag_kmz)
endif
first=.false.
!
endsubroutine calc_jmbmz
!***********************************************************************
subroutine calc_bmxy_rms
!
! Magnetic energy in z averaged field. The bxmxy, bymxy and bzmxy must have
! been calculated, so they are present on the root processor.
!
! 6-apr-08/axel: moved from calc_mfield to here
!
use Diagnostics
use Mpicomm
!
logical, save :: first = .true.
real, dimension(2) :: b2mxy_local, b2mxy
real :: bmxy_rms, nVol2d_local, btemp
integer :: l
!
if (lcylindrical_coords) call not_implemented('calc_bmxy_rms',"bmxy_rms for cylindrical coords")
!
if (.not. lfirst_proc_z) return
!
! The quantities bxmxy,bymxy,bzmxy are required in "zaver.in"
!
bmxy_rms = 0.0
if ((idiag_bxmxy == 0) .or. (idiag_bymxy == 0) .or. (idiag_bzmxy == 0)) then
if (first) &
call warning("calc_bmxy_rms","to get bmxy_rms, set bxmxy, bymxy and bzmxy in 'zaver.in'."// &
achar(10)//"We proceed, but you'll get bmxy_rms=0")
else
b2mxy_local = 0.0
do l=1, nx
do m=1, ny
btemp = fnamexy(idiag_bxmxy,l,m)**2 + fnamexy(idiag_bymxy,l,m)**2 + fnamexy(idiag_bzmxy,l,m)**2
if (lspherical_coords) then
btemp = btemp*r2_weight(l)*sinth_weight(m)
nvol2d_local = r2_weight(l)*sinth_weight(m)
endif
b2mxy_local(1) = b2mxy_local(1) + btemp
b2mxy_local(2) = b2mxy_local(2) + nVol2d_local
enddo
enddo
call mpireduce_sum(b2mxy_local(:),b2mxy,2,idir=IYBEAM)
if (lfirst_proc_x) then
if (lcartesian_coords) bmxy_rms = sqrt(b2mxy(1) / (nxgrid*nygrid))
if (lspherical_coords) bmxy_rms = sqrt(b2mxy(1) / b2mxy(2))
endif
endif
!
! Save the name in the idiag_bmxy_rms slot and set first to false.
!
call save_name(bmxy_rms,idiag_bmxy_rms)
first = .false.
!
endsubroutine calc_bmxy_rms
!***********************************************************************
subroutine calc_bmz_beltrami_phase
!
! The following is useful if the xy-averaged field is a Beltrami field
! Determine its phase as in B ~ [ cos(kz+phi), sin(kz+phi), 0 ].
! This means that for positive phi the wave is shifted to the left.
!
! bxmz, bymz must have been calculated,
! so they are present on the root processor.
!
! 2-apr-08/MR: introduced phase calculation for Beltrami mean fields
! 6-apr-08/axel: moved from calc_mfield to here
!
use Diagnostics
!
logical,save :: first=.true.
real :: bmz_belphase1,bmz_belphase2
real, dimension (nz,nprocz), save :: sinz,cosz
real :: c, s
integer :: jprocz
!
if (first) then
sinz=sin(k1_ff_mag*z_allprocs); cosz=cos(k1_ff_mag*z_allprocs)
endif
!
! print warning if bxmz and bymz are not calculated
!
if (idiag_bxmz==0.or.idiag_bymz==0) then
if (first) &
call warning("calc_bmz_beltrami_phase","to get bmz_beltrami_phase, set bxmz, bymz in 'zaver.in'."// &
achar(10)//"We proceed, but you'll get Beltrami phase bmzpb=0")
bmz_beltrami_phase=0.
!
! add up c = <B_x> cos(kz) and s = <B_x> sin(kz)
! and determine phase of Beltrami field from <B_x>
!
else
c=0.; s=0.
do jprocz=1,nprocz
c=c+dot_product(fnamez(:,jprocz,idiag_bxmz),cosz(:,jprocz))
s=s+dot_product(fnamez(:,jprocz,idiag_bxmz),sinz(:,jprocz))
enddo
bmz_belphase1=atan2(-s,c)
!
! add up c = <B_y> cos(kz) and s = <B_y> sin(kz)
! and determine phase of Beltrami field from <B_y>
!
c=0.; s=0.
do jprocz=1,nprocz
c=c+dot_product(fnamez(:,jprocz,idiag_bymz),cosz(:,jprocz))
s=s+dot_product(fnamez(:,jprocz,idiag_bymz),sinz(:,jprocz))
enddo
bmz_belphase2=atan2(c,s)
!
! Difference of both determinations (to estimate error)
! and take the mean of both calculations (called bmz_beltrami_phase
! and bmzph in the print.in file, for brevity)
!
bmz_beltrami_phase=.5*(bmz_belphase1+bmz_belphase2)
endif
!
! Save the name in the idiag_bmzph slot; as estimate of the error,
! calculate also the difference between the two.
! Finally, set first to false
!
call save_name(bmz_beltrami_phase,idiag_bmzph)
if (idiag_bmzphe/=0) call save_name(abs(bmz_belphase1-bmz_belphase2),idiag_bmzphe)
first=.false.
!
endsubroutine calc_bmz_beltrami_phase
!***********************************************************************
subroutine magnetosonic_x(ampl,f,iuu,iaa,ilnrho,kx,mu0)
!
! Magnetosonic wave propagating in the x-direction
!
! 12-aug-24/axel: coded
!
use EquationOfState, only: cs20
!
real, dimension (mx,my,mz,mfarray) :: f
integer :: iuu,iaa,ilnrho
real :: ampl, kx, mu0, ampl0
real :: s, vA2, oA2, os2, cos2psi, term1, term2, om2, rho0=1.
real :: ampl_lr, ampl_ux, ampl_uy, ampl_Az, cospsi, sinpsi, om
!
! Dispersion relation
!
ampl0=abs(ampl)
s=sign(1.,ampl)
vA2=B_ext2/(mu0*rho0)
oA2=vA2*kx**2
os2=cs20*kx**2
cos2psi=B_ext(1)**2/B_ext2
term1=.5*(oA2+os2)
term2=os2*oA2*cos2psi
om2=term1+s*sqrt(term1**2-term2)
if (lroot) print*,'magnetosonic_x: s,cos2psi,om2=',s,cos2psi,om2
!
! Amplitude factors
!
om=sqrt(om2)
cospsi=sqrt(cos2psi)
sinpsi=sqrt(1.-cos2psi)
ampl_ux=(oA2*cos2psi-om2)*ampl0
ampl_uy=oA2*sinpsi*cospsi*ampl0
ampl_Az=om*sinpsi*ampl0
ampl_lr=om/kx*(oA2*cos2psi-om2)*ampl0
if (lroot) print*,'magnetosonic_x: ampl_uy=',ampl_uy
!
! ux and Ay.
! Don't overwrite the density, just add to the log of it.
! In the lconservative case, lconservative=T, rho is at the moment really rho,
! not T^{00}, because the .5*B^2 term is added later.
!
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iuu+0 )=ampl_ux*cos(kx*x(l1:l2))
f(l1:l2,m,n,iuu+1 )=ampl_uy*cos(kx*x(l1:l2))
f(l1:l2,m,n,iaa+2 )=ampl_Az*sin(kx*x(l1:l2))
f(l1:l2,m,n,ilnrho)=ampl_lr*cos(kx*x(l1:l2))
enddo; enddo
if (lroot) print*,'magnetosonic_x: mu0, kx, ampl_Az=',mu0, kx, ampl_Az
!
endsubroutine magnetosonic_x
!***********************************************************************
subroutine alfven_x(ampl,f,iuu,iaa,ilnrho,kx,mu0)
!
! Alfven wave propagating in the x-direction
!
! uy = +sink(x-vA*t)
! Az = -cosk(x-vA*t)*sqrt(rho*mu0)/k
!
! Alfven and slow magnetosonic are the same here and both incompressible, and
! a fast magnetosonic (compressible) wave is also excited, but decoupled.
!
! satisfies the four equations
! dlnrho/dt = -ux'
! dux/dt = -cs2*(lnrho)'
! duy/dt = B0*By' ==> duy/dt = -B0*Az''
! dBy/dt = B0*uy' ==> dAz/dt = -B0*ux
!
! 8-nov-03/axel: coded
! 29-apr-03/axel: added sqrt(rho*mu0)/k factor
! 7-aug-17/axel: added sqrt(.75) for lrelativistic_eos=T
!
real, dimension (mx,my,mz,mfarray) :: f
integer :: iuu,iaa,ilnrho
real :: ampl,kx,mu0
real :: ampl_lr,ampl_ux,ampl_uy
real, dimension (nx) :: rho,ampl_Az
!
! Amplitude factors
!
ampl_lr=+0.
ampl_ux=+0.
if (ldensity) then
if (lconservative) then
ampl_uy=+ampl*sqrt(4./3.+B_ext2)
elseif (lrelativistic_eos) then
ampl_uy=+ampl*sqrt(.75)
else
ampl_uy=+ampl
endif
endif
if (lroot) print*,'ampl_uy=',ampl_uy
!
! ux and Ay.
! Don't overwrite the density, just add to the log of it.
! In the lconservative case, lconservative=T, rho is at the moment really rho,
! not T^{00}, because the .5*B^2 term is added later.
!
do n=n1,n2; do m=m1,m2
if (ldensity_nolog) then
!-- f(l1:l2,m,n,irho)=f(l1:l2,m,n,irho)+exp(ampl_lr*(sin(kx*x(l1:l2))+f(l1:l2,m,n,irho)))
rho=f(l1:l2,m,n,irho)
else
!-- f(l1:l2,m,n,ilnrho)=f(l1:l2,m,n,ilnrho)+ampl_lr*sin(kx*x(l1:l2))
rho=exp(f(l1:l2,m,n,ilnrho))
endif
!
f(l1:l2,m,n,iuu+0 )=ampl_ux*sin(kx*x(l1:l2))
f(l1:l2,m,n,iuu+1 )=ampl_uy*sin(kx*x(l1:l2))
ampl_Az=-ampl*sqrt(rho*mu0)/kx
f(l1:l2,m,n,iaa+2 )=ampl_Az*cos(kx*x(l1:l2))
if (iez>0) f(l1:l2,m,n,iez)=-ampl_uy*sin(kx*x(l1:l2))*sqrt(B_ext2)
enddo; enddo
if (lroot) print*,'alfven_x: mu0, kx, ampl_Az(1)=',mu0, kx, ampl_Az(1)
!
endsubroutine alfven_x
!***********************************************************************
subroutine alfven_y(ampl,f,iuu,iaa,ky,mu0)
!
! Alfven wave propagating in the y-direction; can be used in 2-d runs.
! ux = cos(ky-ot), for B0y=1 and rho=1.
! Az = sin(ky-ot), ie Bx=-cos(ky-ot)
!
! [wd nov-2006: There should be a 1/ky in the aa term here and in
! alfven_x, I think]
!
! satisfies the equations
! dux/dt = Bx' ==> dux/dt = -Az''
! dBx/dt = ux' ==> dAz/dt = -ux.
!
! 06-dec-06/wolf: adapted from alfven_z
!
real, dimension (mx,my,mz,mfarray) :: f
real :: ampl,ky,mu0
integer :: iuu,iaa
!
! ux and Az
!
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iuu+0) = +ampl*cos(ky*y(m))
f(l1:l2,m,n,iaa+2) = -ampl*sin(ky*y(m))*sqrt(mu0)/ky
enddo; enddo
!
endsubroutine alfven_y
!***********************************************************************
subroutine alfven_z(ampl,f,iuu,iaa,kz,mu0)
!
! Alfven wave propagating in the z-direction
! ux = cos(kz-ot), for B0z=1 and rho=1.
! Ay = sin(kz-ot), ie Bx=-cos(kz-ot)
!
! satisfies the equations
! dux/dt = Bx' ==> dux/dt = -Ay''
! dBx/dt = ux' ==> dAy/dt = -ux.
!
! 18-aug-02/axel: coded
!
real, dimension (mx,my,mz,mfarray) :: f
real :: ampl,kz,mu0
integer :: iuu,iaa
!
! ux and Ay
!
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iuu+0)=+ampl*cos(kz*z(n))
f(l1:l2,m,n,iaa+1)=+ampl*sin(kz*z(n))*sqrt(mu0)
enddo; enddo
!
endsubroutine alfven_z
!***********************************************************************
subroutine alfven_xy(ampl,f,iuu,iaa,kx,ky,mu0)
!
! Alfven wave propagating in the xy-direction; can be used in 2-d runs.
! uz = cos(kx*x+ky*y-ot), for B0=(1,1,0) and rho=1.
! Ax = sin(kx*x+ky*y-ot),
! Ay = sin(kx*x+ky*y-ot),
!
! 16-jun-07/axel: adapted from alfven_y
!
real, dimension (mx,my,mz,mfarray) :: f
real :: ampl,kx,ky,mu0
integer :: iuu,iaa
real :: om
!
! set ux, Ax, and Ay
!
om=B_ext(1)*kx+B_ext(2)*ky
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iuu+2)=+ampl*cos(kx*x(l1:l2)+ky*y(m))
f(l1:l2,m,n,iaa+0)=+ampl*sin(kx*x(l1:l2)+ky*y(m))*sqrt(mu0)/om*B_ext(2)
f(l1:l2,m,n,iaa+1)=-ampl*sin(kx*x(l1:l2)+ky*y(m))*sqrt(mu0)/om*B_ext(1)
enddo; enddo
!
endsubroutine alfven_xy
!***********************************************************************
subroutine alfven_xz(ampl,f,iuu,iaa,kx,kz,mu0)
!
! Alfven wave propagating in the xz-direction; can be used in 2-d runs.
! uz = cos(kx*x+kz*z-ot), for B0=(1,1,0) and rho=1.
! Ax = sin(kx*x+kz*z-ot),
! Az = sin(kx*x+kz*z-ot),
!
! 16-jun-07/axel: adapted from alfven_xy
!
real, dimension (mx,my,mz,mfarray) :: f
real :: ampl,kx,kz,mu0
integer :: iuu,iaa
real :: om
!
! set ux, Ax, and Az
!
om=B_ext(1)*kx+B_ext(3)*kz
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iuu+2)=+ampl*cos(kx*x(l1:l2)+kz*z(n))
f(l1:l2,m,n,iaa+0)=+ampl*sin(kx*x(l1:l2)+kz*z(n))*sqrt(mu0)/om*B_ext(2)
f(l1:l2,m,n,iaa+2)=-ampl*sin(kx*x(l1:l2)+kz*z(n))*sqrt(mu0)/om*B_ext(1)
enddo; enddo
!
endsubroutine alfven_xz
!***********************************************************************
subroutine alfvenz_rot(ampl,f,iuu,iaa,kz,O)
!
! Alfven wave propagating in the z-direction (with Coriolis force)
! ux = cos(kz-ot), for B0z=1 and rho=1.
! Ay = sin(kz-ot), ie Bx=-cos(kz-ot)
!
! satisfies the equations
! dux/dt - 2Omega*uy = -Ay''
! duy/dt + 2Omega*ux = +Ax''
! dAx/dt = +uy
! dAy/dt = -ux
!
! 18-aug-02/axel: coded
!
real, dimension (mx,my,mz,mfarray) :: f
real :: ampl,kz,O,fac
integer :: iuu,iaa
!
! ux, uy, Ax and Ay
!
if (lroot) print*,'alfvenz_rot: Alfven wave with rotation; O,kz=',O,kz
fac=-O+sqrt(O**2+kz**2)
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iuu+0)=-ampl*sin(kz*z(n))*fac/kz
f(l1:l2,m,n,iuu+1)=-ampl*cos(kz*z(n))*fac/kz
f(l1:l2,m,n,iaa+0)=+ampl*sin(kz*z(n))/kz
f(l1:l2,m,n,iaa+1)=+ampl*cos(kz*z(n))/kz
enddo; enddo
!
endsubroutine alfvenz_rot
!***********************************************************************
subroutine alfvenz_bell(ampl,f,iuu,iaa,kz,B0,J0)
!
! Bell instability for the pressureless equations
! du/dt = j x B0 - J0 x b
! da/dt = u x B0
!
! 13-jan-12/axel: coded
!
real, dimension (mx,my,mz,mfarray) :: f
real :: ampl,kz,B0,J0,lam,oA
integer :: iuu,iaa
!
! ux, uy, Ax and Ay
!
oA=kz*B0
lam=sqrt(oA*(J0-oA))
if (lroot) print*,'alfvenz_bell: Bell inst., lam,kz,oA,B0,J0=',lam,kz,oA,B0,J0
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iuu+0)=-ampl*sin(kz*z(n))*lam/kz
f(l1:l2,m,n,iuu+1)=+ampl*cos(kz*z(n))*lam/kz
f(l1:l2,m,n,iaa+0)=+ampl*cos(kz*z(n))*B0/kz
f(l1:l2,m,n,iaa+1)=+ampl*sin(kz*z(n))*B0/kz
enddo; enddo
!
endsubroutine alfvenz_bell
!***********************************************************************
subroutine alfvenz_rot_shear(ampl,f,iuu,iaa,kz,OO)
!
! Alfven wave propagating in the z-direction (with Coriolis force and shear)
!
! satisfies the equations
! dux/dt - 2*Omega*uy = -Ay''
! duy/dt + (2-q)*Omega*ux = +Ax''
! dAx/dt = q*Omega*Ay + uy
! dAy/dt = -ux
!
! Assume B0=rho0=mu0=1
!
! 28-june-04/anders: coded
!
real, dimension (mx,my,mz,mfarray) :: f
real :: ampl,kz,OO
complex :: fac
integer :: iuu,iaa
!
! ux, uy, Ax and Ay
!
if (lroot) print*,'alfvenz_rot_shear: Alfven wave with rotation and shear; OO,kz=',OO,kz
fac=cmplx(OO-sqrt(16*kz**2+OO**2),0.)
do n=n1,n2; do m=m1,m2
f(l1:l2,m,n,iuu+0)=f(l1:l2,m,n,iuu+0)+ampl*fac/(4*kz)*sin(kz*z(n))
f(l1:l2,m,n,iuu+1)=f(l1:l2,m,n,iuu+1)+ampl*real(exp(cmplx(0,z(n)*kz))* &
fac*sqrt(2*kz**2+OO*fac)/(sqrt(2.)*kz*(-6*OO-fac)))
f(l1:l2,m,n,iaa+0)=f(l1:l2,m,n,iaa+0)+ampl*sin(kz*z(n))/kz
f(l1:l2,m,n,iaa+1)=f(l1:l2,m,n,iaa+1)-ampl*2*sqrt(2.)*aimag(exp(cmplx(0,z(n)*kz))* &
sqrt(2*kz**2+OO*fac)/(-6*OO-fac)/(cmplx(0,kz)))
enddo; enddo
!
endsubroutine alfvenz_rot_shear
!***********************************************************************
subroutine torus_test(ampl,f,kx_aa,ky_aa)
!
! Initial field concentrated along torus well inside the computational
! domain.
! Implements the same field for cartesian and spherical cordinates.
! The field is of mixed parity (bb_pol symmetric, bb_tor antisymmetric)
! and the relative contributions of toroidal and poloidal field are
! determined by
! ampl(1) -- bb_pol (through aa_tor)
! ampl(3) -- bb_tor (through aa_pol)
! Uses x_max as reference radius.
!
! 05-may-2008/wolf: coded
!
real :: ampl,kx_aa,ky_aa
real, dimension (mx,my,mz,mfarray) :: f
!
real, dimension (nx) :: xxi2,ee
real, dimension (nx) :: costh,sinth,cosphi,sinphi,ss,rr,aar,aap
real :: radius,width,r_cent
!
intent(in) :: ampl
intent(inout) :: f
!
radius = xyz1(1)
width = 0.1*radius*kx_aa
r_cent = 0.6*radius*ky_aa
!
if (lspherical_coords) then
do n=n1,n2; do m=m1,m2
xxi2 = (x(l1:l2)*sin(y(m))-r_cent)**2 + x(l1:l2)**2*cos(y(m))**2
ee = ampl * exp(-0.5 * xxi2 / width**2)
f(l1:l2,m,n,iax) = f(l1:l2,m,n,iax) + ee * x(l1:l2)*cos(y(m))
f(l1:l2,m,n,iaz) = f(l1:l2,m,n,iaz) + ee
enddo; enddo
else
do n=n1,n2; do m=m1,m2
xxi2 = (sqrt(x(l1:l2)**2+y(m)**2) - r_cent)**2 + z(n)**2
ee = ampl * exp(-0.5 * xxi2 / width**2)
aar = z(n) * ee
aap = ee
ss = sqrt(x(l1:l2)**2+y(m)**2)
rr = sqrt(x(l1:l2)**2+y(m)**2+z(n)**2)
ss = max(ss, tini)
rr = max(rr, tini)
costh = z(n)/rr
sinth = ss/rr
cosphi = x(l1:l2)/ss
sinphi = y(m)/ss
f(l1:l2,m,n,iax) = f(l1:l2,m,n,iax) + aar*sinth*cosphi - aap*sinphi
f(l1:l2,m,n,iay) = f(l1:l2,m,n,iay) + aar*sinth*sinphi + aap*cosphi
f(l1:l2,m,n,iaz) = f(l1:l2,m,n,iaz) + aar*costh
enddo; enddo
endif
!
endsubroutine torus_test
!***********************************************************************
subroutine force_free_jet(mu)
!
! Force free magnetic field configuration for jet simulations
! with a fixed accretion disc at the bottom boundary.
!
! The input parameter mu specifies the radial dependency of
! the magnetic field in the disc.
!
! Solves the laplace equation in cylindrical coordinates for the
! phi-component of the vector potential. A_r and A_z are taken to
! be zero.
!
! nabla**2 A_phi - A_phi / r**2 = 0
!
! For the desired boundary condition in the accretion disc
!
! B_r=B0*r**(mu-1) (z == 0)
!
! the solution is
!
! A_phi = Hypergeometric2F1( (1-mu)/2, (2+mu)/2, 2, xi**2 )
! *xi*(r**2+z**2)**(mu/2)
!
! where xi = sqrt(r**2/(r**2+z**2))
!
! 30-may-04/tobi: coded
!
use Sub, only: hypergeometric2F1,gamma_function
use Deriv, only: der
use Debug_IO, only: output
!
real, intent(in) :: mu
real :: xi2,A_phi
real :: r2
real :: B1r_,B1z_,B1
real, parameter :: tol=10*epsilon(1.0)
integer :: l
real, dimension(mx,my,mz) :: Ax_ext,Ay_ext
!real, dimension(nx,3) :: bb_ext_pot
!real, dimension(nx) :: bb_x,bb_y,bb_z
!
! calculate un-normalized |B| at r=r_ref and z=0 for later normalization
!
if (lroot.and.ip<=5) print*,'FORCE_FREE_JET: calculating normalization'
!
B1r_=sin(pi*mu/2)*gamma_function( abs(mu) /2) / gamma_function((1+abs(mu))/2)
!
B1z_=cos(pi*mu/2)*gamma_function((1+abs(mu))/2) / gamma_function((2+abs(mu))/2)
!
B1=sqrt(4/pi)*r_ref**(mu-1)*sqrt(B1r_**2+B1z_**2)
!
! calculate external vector potential
!
if (lroot) print*,'FORCE_FREE_JET: calculating external vector potential'
!
if (lforce_free_test) then
!
if (lroot) print*,'FORCE_FREE_JET: using analytic solution for mu=-1'
do l=1,mx; do m=1,my; do n=1,mz
Ax_ext=-2*y(m)*(1-z(n)/sqrt(x(l)**2+y(m)**2+z(n)**2))/(x(l)**2+y(m)**2)/B1
Ay_ext= 2*x(l)*(1-z(n)/sqrt(x(l)**2+y(m)**2+z(n)**2))/(x(l)**2+y(m)**2)/B1
enddo; enddo; enddo
!
else
!
do l=1,mx; do m=1,my; do n=1,mz
r2=x(l)**2+y(m)**2
xi2=r2/(r2+z(n)**2)
A_phi=hypergeometric2F1((1-mu)/2,(2+mu)/2,2.0,xi2,tol)*sqrt(xi2)*sqrt(r2+z(n)**2)**mu/B1
!
Ax_ext(l,m,n)=-y(m)*A_phi/sqrt(r2)
Ay_ext(l,m,n)= x(l)*A_phi/sqrt(r2)
enddo; enddo; enddo
!
endif
!
! calculate external magnetic field
!
if (lroot.and.ip<=5) print*,'FORCE_FREE_JET: calculating the external magnetic field'
!
do n=n1,n2
do m=m1,m2
! call der(Ay_ext,bb_x,3)
! bb_ext_pot(:,1)=-bb_x
! call der(Ax_ext,bb_y,3)
! bb_ext_pot(:,2)= bb_y
! call der(Ay_ext,bb_z,1)
! bb_ext_pot(:,3)= bb_z
! call der(Ax_ext,bb_z,2)
! bb_ext_pot(:,3)=bb_ext_pot(:,3)-bb_z
! call set_global(bb_ext_pot,m,n,'B_ext_pot',nx)
enddo
enddo
!
if (ip<=5) then
call output(trim(directory)//'/Ax_ext.dat',Ax_ext,1)
call output(trim(directory)//'/Ay_ext.dat',Ay_ext,1)
endif
!
endsubroutine force_free_jet
!***********************************************************************
subroutine piecew_dipole_aa(ampl,inclaa,f,ivar)
!
! A field that is vertical uniform for r<R_int, inclined dipolar for
! r>R_ext, and potential in the shell R_int<r<R_ext.
! This mimics a neutron star just after the Meissner effect forced the
! internal field to become vertical (aligned with rotation axis).
!
! AMPL represents mu/4 pi, where mu = 1/2 Int rr jj dV is the
! magnetic moment of the external dipole field.
! INCLAA is the inclination of the dipolar field.
!
! Pencilized in order to minimize memory consumption with all the
! auxiliary variables used.
!
! 23-jul-05/wolf:coded
!
real, intent(inout), dimension (mx,my,mz,mfarray) :: f
real, intent(in) :: ampl,inclaa
real, dimension (nx) :: r_1_mn,r_2_mn,sigma0,sigma1, r_mn
real :: fact
real, dimension(2) :: beta(0:1)
real, dimension(2,3) :: a(0:1,1:3),b(0:1,1:3)
integer :: ivar
!
do imn=1,nyz
n=nn(imn)
m=mm(imn)
r_mn=sqrt(x(l1:l2)**2+y(m)**2+z(n)**2)
r_1_mn = 1./max(r_mn,tini)
r_2_mn = 1./max(r_mn**2,tini)
!
fact = ampl
! beta = [beta_1^0, beta_1^1] combines coefficients for m=0, m=1
beta = fact * (/ cos(inclaa), -sin(inclaa)/sqrt(2.) /)
! a and b for m=0, m=1 (index 1) and interior, shell, exterior index 2)
a(0,:) = (/ 1./r_ext**3, 1./r_ext**3 , 0. /) * beta(0)
a(1,:) = (/ 0. , 1./(r_ext**3-r_int**3) , 0. /) * beta(1)
!
b(0,:) = (/ 0. , 0. , 1. /) * beta(0)
b(1,:) = (/ 0. , -r_int**3/(r_ext**3-r_int**3), 1. /) * beta(1)
!
! The following could be coded much clearer using elsewhere, but
! that is not in F90 (and pgf90 doesn't support F95)
! r_in < r < r_ext
sigma0 = a(0,2)*r_mn + b(0,2)*r_2_mn
sigma1 = a(1,2)*r_mn + b(1,2)*r_2_mn
where(r_mn>r_ext) ! r > r_ext
sigma0 = a(0,3)*r_mn + b(0,3)*r_2_mn
sigma1 = a(1,3)*r_mn + b(1,3)*r_2_mn
endwhere
where(r_mn<r_int) ! r < r_int
sigma0 = a(0,1)*r_mn + b(0,1)*r_2_mn
sigma1 = a(1,1)*r_mn + b(1,1)*r_2_mn
endwhere
sigma1 = sigma1*sqrt(2.)
f(l1:l2,m,n,ivar+0) = -sigma0*y(m)*r_1_mn
f(l1:l2,m,n,ivar+1) = sigma0*x(l1:l2)*r_1_mn + sigma1*z(n)*r_1_mn
f(l1:l2,m,n,ivar+2) = - sigma1*y(m)*r_1_mn
enddo
!
endsubroutine piecew_dipole_aa
!***********************************************************************
subroutine geo_benchmark_B(f)
!
! 30-june-04/grs: coded
!
real, dimension (mx,my,mz,mfarray), intent(inout) :: f
real, dimension(nx) :: theta_mn,ar,atheta,aphi,r_mn,phi_mn
real :: C_int,C_ext,A_int,A_ext
integer :: j
!
do imn=1,nyz
n=nn(imn)
m=mm(imn)
r_mn=sqrt(x(l1:l2)**2+y(m)**2+z(n)**2)
theta_mn=acos(spread(z(n),1,nx)/r_mn)
phi_mn=atan2(spread(y(m),1,nx),x(l1:l2))
!
! calculate ax,ay,az (via ar,atheta,aphi) inside shell (& leave zero outside shell)
!
do j=1,ninit
select case (initaa(j))
case ('geo-benchmark-case1')
if (lroot .and. imn==1) print*, 'geo_benchmark_B: geo-benchmark-case1'
C_int=-( -1./63.*r_int**4 + 11./84.*r_int**3*r_ext &
+ 317./1050.*r_int**2*r_ext**2 &
- 1./5.*r_int**2*r_ext**2*log(r_int) )
C_ext=-( -1./63.*r_ext**9 + 11./84.*r_ext**8*r_int &
+ 317./1050.*r_ext**7*r_int**2 &
- 1./5.*r_ext**7*r_int**2*log(r_ext) )
A_int=5./2.*(r_ext-r_int)
A_ext=5./8.*(r_ext**4-r_int**4)
!
where (r_mn < r_int)
ar=C_int*ampl_B0*80.*2.*(3.*sin(theta_mn)**2-2.)*r_mn
atheta=3.*C_int*ampl_B0*80.*sin(2.*theta_mn)*r_mn
aphi=ampl_B0*A_int*r_mn*sin(theta_mn)
endwhere
!
where (r_mn <= r_ext .and. r_mn >= r_int)
ar=ampl_B0*80.*2.*(3.*sin(theta_mn)**2-2.)* &
( 1./36.*r_mn**5 - 1./12.*(r_int+r_ext)*r_mn**4 &
+ 1./14.*(r_int**2+4.*r_int*r_ext+r_ext**2)*r_mn**3 &
- 1./3.*(r_int**2*r_ext+r_int*r_ext**2)*r_mn**2 &
- 1./25.*r_int**2*r_ext**2*r_mn &
+ 1./5.*r_int**2*r_ext**2*r_mn*log(r_mn) )
atheta=-ampl_B0*80.*sin(2.*theta_mn)* &
( 7./36.*r_mn**5 - 1./2.*(r_int+r_ext)*r_mn**4 &
+ 5./14.*(r_int**2+4.*r_int*r_ext+r_ext**2)*r_mn**3 &
- 4./3.*(r_int**2*r_ext+r_int*r_ext**2)*r_mn**2 &
+ 2./25.*r_int**2*r_ext**2*r_mn &
+ 3./5.*r_int**2*r_ext**2*r_mn*log(r_mn) )
aphi=ampl_B0*5./8.*sin(theta_mn)* &
( 4.*r_ext*r_mn - 3.*r_mn**2 - r_int**4/r_mn**2 )
endwhere
!
where (r_mn > r_ext)
ar=C_ext*ampl_B0*80.*2.*(3.*sin(theta_mn)**2-2.)/r_mn**4
atheta=-2.*C_ext*ampl_B0*80.*sin(2.*theta_mn)/r_mn**4
aphi=ampl_B0*A_ext/r_mn**2*sin(theta_mn)
endwhere
!
! debug checks -- look at a pencil near the centre...
if (ip<=4 .and. imn==(ny+1)*nz/2) then
print*,'r_int,r_ext',r_int,r_ext
write(*,'(a45,2i6,2f15.7)') 'geo_benchmark_B: minmax(r_mn), imn, iproc:', &
iproc, imn, minval(r_mn), maxval(r_mn)
write(*,'(a45,2i6,2f15.7)') 'geo_benchmark_B: minmax(theta_mn), imn, iproc:', &
iproc, imn, minval(theta_mn), maxval(theta_mn)
write(*,'(a45,2i6,2f15.7)') 'geo_benchmark_B: minmax(phi_mn), imn, iproc:', &
iproc, imn, minval(phi_mn), maxval(phi_mn)
write(*,'(a45,2i6,2f15.7)') 'geo_benchmark_B: minmax(ar), imn, iproc:', &
iproc, imn, minval(ar), maxval(ar)
write(*,'(a45,2i6,2f15.7)') &
'geo_benchmark_B: minmax(atheta), imn, iproc:', iproc, imn, minval(atheta), maxval(atheta)
write(*,'(a45,2i6,2f15.7)') &
'geo_benchmark_B: minmax(aphi), imn, iproc:', iproc, imn, minval(aphi), maxval(aphi)
endif
!
case ('geo-benchmark-case2')
if (lroot .and. imn==1) print*, 'geo_benchmark_B: geo-benchmark-case2 not yet coded.'
!
case ('nothing')
if (lroot .and. imn==1) print*, 'geo_benchmark_B: nothing more to add (in ninit loop).'
exit
!
case default
call fatal_error("geo_benchmark_B",'no such initaa: '//trim(initaa(j)))
endselect
enddo
f(l1:l2,m,n,iax)=sin(theta_mn)*cos(phi_mn)*ar + cos(theta_mn)*cos(phi_mn)*atheta - sin(phi_mn)*aphi
f(l1:l2,m,n,iay)=sin(theta_mn)*sin(phi_mn)*ar + cos(theta_mn)*sin(phi_mn)*atheta + cos(phi_mn)*aphi
f(l1:l2,m,n,iaz)=cos(theta_mn)*ar - sin(theta_mn)*atheta
enddo
!
!
if (ip<=14) then
print*,'geo_benchmark_B: minmax(ax) on iproc: ',iproc,minval(f(l1:l2,m1:m2,n1:n2,iax)),maxval(f(l1:l2,m1:m2,n1:n2,iax))
print*,'geo_benchmark_B: minmax(ay) on iproc: ',iproc,minval(f(l1:l2,m1:m2,n1:n2,iay)),maxval(f(l1:l2,m1:m2,n1:n2,iay))
print*,'geo_benchmark_B: minmax(az) on iproc: ',iproc,minval(f(l1:l2,m1:m2,n1:n2,iaz)),maxval(f(l1:l2,m1:m2,n1:n2,iaz))
endif
!
endsubroutine geo_benchmark_B
!***********************************************************************
subroutine eta_xy_dep(eta_xy,geta_xy,eta_xy_profile)
!
! 2-jul-2009/koen: creates an xy-dependent resistivity (for RFP studies)
! (under reconstruction)
!
real, dimension(mx,my) :: eta_xy,r2,gradr_eta_xy
real, dimension(mx,my,3) :: geta_xy
character (len=labellen) :: eta_xy_profile
real :: rmax2,a,w
integer :: i,j
!
intent(out) :: eta_xy,geta_xy
!
select case (eta_xy_profile)
case ('schnack89')
do i=1,mx
do j=1,my
r2(i,j)=x(i)**2+y(j)**2
enddo
enddo
!
! define eta_xy: radial resistivity profile from Y.L. Ho, S.C. Prager &
! D.D. Schnack, Phys rev letters vol 62 nr 13 1989
! and define gradr_eta_xy: 1/r *d_r(eta_xy))
!
! to prevent numerically impossible diffusivities the value outside rmax2
! the diffusivity is set to stay below an input value eta_xy_max (> 100*eta),
! keeping the transition continuous in the first derivative
!
rmax2=1.
a=(eta_xy_max-100.*eta)/eta_xy_max
w=(eta_xy_max-100.*eta)/(5400.*eta)
!
do i=1,mx
do j=1,my
! inside
if (r2(i,j) < rmax2) then
eta_xy(i,j) = eta*(1.+9.*(r2(i,j)/rmax2)**15)**2
gradr_eta_xy= 540.*eta*(1.+9.*(r2(i,j)/rmax2)**15)*(r2(i,j)/rmax2)**14/rmax2**0.5
! outside
else
eta_xy(i,j) = eta_xy_max*(1.-a*exp(-(r2(i,j)**0.5-rmax2**0.5)/w))
gradr_eta_xy(i,j)= eta_xy_max*(a*exp(-(r2(i,j)**0.5-rmax2**0.5)/w))/w/rmax2**0.5
endif
! gradient
geta_xy(i,j,1) = x(i)*gradr_eta_xy(i,j)
geta_xy(i,j,2) = y(j)*gradr_eta_xy(i,j)
geta_xy(i,j,3) = 0.
enddo
enddo
!
endselect
!
endsubroutine eta_xy_dep
!***********************************************************************
subroutine eta_zdep(zdep_profile, nz, z, eta_z, geta_z)
!
! creates a z-dependent resistivity for protoplanetary disk studies
!
! 12-jul-2005/joishi: coded
!
! Input Arguments
! zdep_profile: name/code of the z-dependent profile
! nz: number of elements in array z
! z: z coordinates
! Output Arguments
! eta_z: resistivity at the corresponding z
! Optional Output Arguments
! geta_z: gradient of resistivity at the corresponding z
!
use General, only: erfcc
use Sub, only: step, der_step, cubic_step, cubic_der_step,erfunc
use EquationOfState, only: cs20
!
character(len=labellen), intent(in) :: zdep_profile
integer, intent(in) :: nz
real, dimension(nz), intent(in) :: z
real, dimension(nz), intent(out) :: eta_z
real, dimension(nz), intent(out), optional :: geta_z
!
real, dimension(nz) :: zoh, z2
real :: h
!
select case (zdep_profile)
!
! cos(z) profile
!
case ('cos(z)')
eta_z=eta*(1.+eta_ampl*cos(z))
if (present(geta_z)) geta_z=-eta*eta_ampl*sin(z)
!
case ('fs')
if (cs20 > 0. .and. Omega > 0.) then
h = sqrt(2. * cs20) / Omega
else
h = 1.
endif
zoh = z / h
z2 = zoh**2
!
! resistivity profile from Fleming & Stone (ApJ 585:908-920)
! eta_z = eta*exp(-z2/2.+sigma_ratio*erfcc(abs(z))/4.)
eta_z = eta * exp(-0.5 * z2 + 0.25 * sigma_ratio * erfcc(abs(zoh)))
!
! its gradient:
!
if (present(geta_z)) &
geta_z = -eta_z * (zoh + (0.5 * sigma_ratio / sqrt(pi)) * sign(1.,z) * exp(-z2)) / h
!
case ('tanh')
! default to spread gradient over ~5 grid cells.
if (eta_zwidth == 0.) eta_zwidth = 5.*dz
eta_z = eta*0.5*(tanh((z + eta_z0)/eta_zwidth) - tanh((z - eta_z0)/eta_zwidth))
!
! its gradient:
if (present(geta_z)) geta_z = -eta/(2.*eta_zwidth) * &
((tanh((z + eta_z0)/eta_zwidth))**2. &
-(tanh((z - eta_z0)/eta_zwidth))**2.)
!
! Single tanh step function
!
case ('step')
!
! default to spread gradient over ~5 grid cells.
!
if (eta_zwidth == 0.) eta_zwidth = 5.*dz
eta_z = eta + eta*(eta_jump-1.)*step(z,eta_z0,-eta_zwidth)
!
! its gradient:
if (present(geta_z)) geta_z = eta*(eta_jump-1.)*der_step(z,eta_z0,-eta_zwidth)
!
!
! Cubic-step profile
!
case ('cubic_step')
!
if (eta_zwidth == 0.) eta_zwidth = 5.*dz
eta_z = eta + eta*(eta_jump-1.)*cubic_step(z,eta_z0,-eta_zwidth)
!
! its gradient:
!
if (present(geta_z)) geta_z = eta*(eta_jump-1.)*cubic_der_step(z,eta_z0,-eta_zwidth)
!
! zlayer: eta is peaked within eta_z0 and eta_z1 and decreases outside.
! the profile is made exactly the same as the similarly named profile in
! the forcing module.
!
case ('zlayer')
!
! Default to spread gradient over ~5 grid cells,
!
if (eta_zwidth == 0.) eta_zwidth = 5.*dz
eta_z = eta*eta_jump + (eta-eta*eta_jump)*(.5*(1.+erfunc((z-eta_z0)/eta_zwidth)) &
-.5*(1.+erfunc((z-eta_z1)/eta_zwidth)) )
!
! and its gradient
!
if (present(geta_z)) &
geta_z = (eta-eta*eta_jump)*(exp(((z-eta_z0)**2)/(eta_zwidth**2)) &
- exp(((z-eta_z1)**2)/(eta_zwidth**2)))/(eta_zwidth*sqrt(pi))
!
! Two-step function
!
case ('two-step','two_step')
!
! Default to spread gradient over ~5 grid cells,
!
if (eta_zwidth == 0.) eta_zwidth = 5.*dz
eta_z = eta*eta_jump-eta*(eta_jump-two_step_factor)* &
(step(z,eta_z0,eta_zwidth)-step(z,eta_z1,eta_zwidth))
!
! ... and its gradient. Note that the sign of the second term enters
! with the opposite sign, because we have used negative eta_zwidth.
!
if (present(geta_z)) &
geta_z = eta*(eta_jump-two_step_factor)*( &
der_step(z,eta_z0,-eta_zwidth)+der_step(z,eta_z1,eta_zwidth))
!
!
! Cubic-two-step profile
!
case ('cubic_two_step')
!
if (eta_zwidth == 0.) eta_zwidth = 5.*dz
if (eta_zwidth2 == 0.) eta_zwidth2 = 5.*dz
eta_z = (eta + eta*(eta_jump-1.)*cubic_step(z,eta_z0,-eta_zwidth))* &
(1+(eta_jump2-1.)*cubic_step(z,eta_z1,-eta_zwidth2))
!
! its gradient:
if (present(geta_z)) then
geta_z = (eta*(eta_jump-1.)*cubic_der_step(z,eta_z0,-eta_zwidth))* &
(1+(eta_jump2-1.)*cubic_step(z,eta_z1,-eta_zwidth2)) &
+ (eta + eta*(eta_jump-1.)*cubic_step(z,eta_z0,-eta_zwidth))* &
((eta_jump2-1.)*cubic_der_step(z,eta_z1,-eta_zwidth2))
endif
!
! Powerlaw-z
!
case ('powerlaw-z','powerlaw_z')
!
! eta proportional to chosen power of z...
!
eta_z = eta*(1.+(z-z0)/eta_z0)**eta_power_z
!
! ... and its gradient.
!
if (present(geta_z)) geta_z = eta_power_z*eta_z/(eta_z0+z)
endselect
!
endsubroutine eta_zdep
!***********************************************************************
subroutine eta_ydep(ydep_profile, ny, y, eta_y, geta_y)
!
! creates a z-dependent resistivity for protoplanetary disk studies
!
! 19-aug-2013/wlad: adapted from eta_zdep
!
use General, only: erfcc
use Sub, only: step, der_step
!
character(len=labellen), intent(in) :: ydep_profile
integer, intent(in) :: ny
real, dimension(ny), intent(in) :: y
real, dimension(ny), intent(out) :: eta_y
real, dimension(ny), intent(out), optional :: geta_y
!
select case (ydep_profile)
!
! cos(y) profile
!
case ('cos(y)')
eta_y=eta*(1.+eta_ampl*cos(y))
if (present(geta_y)) geta_y=-eta*eta_ampl*sin(y)
!
!
! Two-step function
!
case ('two-step','two_step')
!
! Default to spread gradient over ~5 grid cells,
!
if (eta_ywidth == 0.) eta_ywidth = 5.*dy
eta_y = eta*eta_jump-eta*(eta_jump-two_step_factor)* &
(step(y,eta_y0,eta_ywidth)-step(y,eta_y1,eta_ywidth))
!
! ... and its gradient. Note that the sign of the second term enters
! with the opposite sign, because we have used negative eta_ywidth.
!
if (present(geta_y)) then
geta_y = eta*(eta_jump-two_step_factor)*( &
der_step(y,eta_y0,-eta_ywidth)+der_step(y,eta_y1,eta_ywidth))
endif
!
case ('bound')
!
! Similar to two-step case, but fixes the profile to enhancement
! near the latitudinal boundary
!
! Default to spread gradient over ~5 grid cells,
!
if (eta_ywidth == 0.) eta_ywidth = 5.*dy
eta_y = eta + (eta*(eta_jump-1.))* &
(step(y,xyz1(2)-3.*eta_ywidth,eta_ywidth)+step(y,xyz0(2)+3.*eta_ywidth,-eta_ywidth))
!
! ... and its gradient.
!
if (present(geta_y)) then
geta_y = (eta*(eta_jump-1.))* &
(der_step(y,xyz1(2)-3.*eta_ywidth,eta_ywidth)+der_step(y,xyz0(2)+3.*eta_ywidth,-eta_ywidth))
endif
endselect
!
endsubroutine eta_ydep
!***********************************************************************
subroutine eta_xdep(eta_x,geta_x,xdep_profile)
!
! creates a x-dependent resistivity for protoplanetary disk studies
!
! 09-mar-2011/wlad: adapted from eta_zdep
! 10-mar-2011/axel: corrected gradient term: should point in x
!
use General, only: erfcc
use Sub, only: step, der_step
!
real, dimension(mx) :: eta_x
real, dimension(mx) :: geta_x
character (len=labellen) :: xdep_profile
integer :: l
!
intent(out) :: eta_x,geta_x
!
real, dimension(mx) :: x2
select case (xdep_profile)
case ('fs')
x2 = x**2.
!
! resistivity profile from Fleming & Stone (ApJ 585:908-920)
!
eta_x = eta*exp(-x2/2.+sigma_ratio*erfcc(abs(x))/4.)
!
! its gradient:
!
geta_x = eta_x*(-x-sign(1.,x)*sigma_ratio*exp(-x2)/(2.*sqrt(pi)))
!
! tanh profile
!
case ('tanh')
!
eta_x = eta*0.5*(tanh((x + eta_x0)/eta_xwidth) - tanh((x - eta_x0)/eta_xwidth))
!
! its gradient:
!
geta_x = -eta/(2.*eta_xwidth) * ((tanh((x + eta_x0)/eta_xwidth))**2. &
-(tanh((x - eta_x0)/eta_xwidth))**2.)
!
! linear profile
!
case ('linear')
!
! default to spread gradient over ~5 grid cells.
!
eta_x = eta*(1.+(x-xyz1(1)))/merge(Lxyz(1),eta_xwidth,eta_xwidth==0.)
!
! its gradient:
!
geta_x = eta/eta_xwidth
!
case ('quadratic')
eta_x = eta*((2.*x-(xyz0(1)+xyz1(1)))/Lxyz(1))**2+eta_min
geta_x = (4./Lxyz(1))*eta*((2.*x-(xyz0(1)+xyz1(1)))/Lxyz(1))
!
! Single step function
! Note that eta_x increases with increasing x when eta_xwidth is negative (!)
!
case ('step')
!
! default to spread gradient over ~5 grid cells.
!
if (eta_xwidth == 0.) eta_xwidth = 5.*dx
eta_x = eta + eta*(eta_jump-1.)*step(x,eta_x0,-eta_xwidth)
!
! its gradient:
! Note that geta_x points then only in the x direction.
!
geta_x = eta*(eta_jump-1.)*der_step(x,eta_x0,-eta_xwidth)
!
case ('RFP_1D')
!
eta_x = eta*(1+9*(x/radRFP)**30)**2
!
! its gradient:
!
geta_x = 2*eta*(1+9*(x/radRFP)**30)*270*(x/radRFP)**29/radRFP
!
! Two-step function
!
case ('two_step','two-step')
!
eta_x = eta*eta_jump-eta*(eta_jump-two_step_factor)* &
(step(x,eta_x0,eta_xwidth0)-step(x,eta_x1,eta_xwidth1))
!
! ... and its gradient. Note that the sign of the second term enters
! with the opposite sign, because we have used negative eta_xwidth.
! Note that geta_x points then only in the x direction.
!
geta_x = eta*(eta_jump-two_step_factor)*( &
der_step(x,eta_x0,-eta_xwidth0)+der_step(x,eta_x1,eta_xwidth1))
!
! Powerlaw-x
!
case ('powerlaw-x','powerlaw_x')
!
! eta proportional to chosen power of x...
!
eta_x = eta*(1.+(x-x0)/eta_x0)**eta_power_x
!
! ... and its gradient.
!
geta_x = eta_power_x*eta_x/(eta_x0+x)
!
! Powerlaw-x2: same profile as for viscosity (will produce eta=0 if
! x crosses zero)
!
case ('powerlaw-x2','powerlaw_x2')
!
! eta proportional to chosen power of x...
!
eta_x = eta*(x/eta_x0)**eta_power_x
!
! ... and its gradient.
!
geta_x = eta_power_x*eta_x/eta_x0
!
endselect
!
! debug output (currently only on root processor)
!
if (lroot.and.ldebug) then
print*
print*,'x, eta_x, geta_x'
do l=l1,l2
write(*,'(1p,3e11.3)') x(l),eta_x(l),geta_x(l)
enddo
endif
!
endsubroutine eta_xdep
!***********************************************************************
subroutine eta_rdep(eta_r,geta_r,rdep_profile,p)
!
! creates a r-dependent resistivity
!
! 11-mar-2019/pete: adapted from eta_xdep
!
use Sub, only: step, der_step
!
real, dimension(nx) :: eta_r
real, dimension(nx,3) :: geta_r
character (len=labellen), intent(in) :: rdep_profile
type (pencil_case) :: p
intent(out) :: eta_r,geta_r
!
integer :: l
real, dimension(nx) :: tmp1,tmp2,prof0,prof1,derprof0,derprof1
!
select case (rdep_profile)
!
! Single step function
! Note that eta_r increases with increasing r when eta_rwidth is negative (!)
!
case ('step')
!
tmp1=p%r_mn
! tmp1=sqrt(x(l1:l2)**2+y(m)**2+z(n)**2)
eta_r = eta + eta*(eta_jump-1.)*step(tmp1,eta_r0,-eta_rwidth)
!
! its gradient:
!
tmp2 = eta*(eta_jump-1.)*der_step(tmp1,eta_r0,-eta_rwidth)
geta_r(:,1)=tmp2*x(l1:l2)*p%r_mn1
geta_r(:,2)=tmp2*y( m )*p%r_mn1
geta_r(:,3)=tmp2*z( n )*p%r_mn1
!
! Two-step function
!
case ('two_step','two-step')
!
eta_r = eta + eta*(eta_jump - 1.)* &
(step(p%r_mn,eta_r0,eta_rwidth0) - step(p%r_mn,eta_r1,eta_rwidth1))
!
! ... and its gradient.
!
tmp1 = eta*(eta_jump-1.)*( &
der_step(p%r_mn,eta_r0,eta_rwidth0) - der_step(p%r_mn,eta_r1,eta_rwidth1))
geta_r(:,1)=tmp1*x(l1:l2)*p%r_mn1(l1:l2)
geta_r(:,2)=tmp1*y( m )*p%r_mn1(l1:l2)
geta_r(:,3)=tmp1*z( n )*p%r_mn1(l1:l2)
!
! Two-step function with different step sizes
!
case ('two_step2','two-step2')
!
! Allow for the each step to have separate width and height.
! Here eta_jump0 and eta_jump1 are ratios with respect to eta.
!
! Compute eta-profile
!
prof1 = step(p%r_mn,eta_r1,eta_rwidth1)
prof0 = step(p%r_mn,eta_r0,eta_rwidth0) - prof1
derprof1 = der_step(p%r_mn,eta_r1,eta_rwidth1)
derprof0 = der_step(p%r_mn,eta_r0,eta_rwidth0) - derprof1
!
eta_r = eta + (eta*(eta_jump0-1.))*prof0 + (eta*(eta_jump1-1.))*prof1
!
! ... and its gradient.
!
tmp1 = eta + (eta*(eta_jump0-1.))*derprof0 + (eta*(eta_jump1-1.))*derprof1
geta_r(:,1)=tmp1*x(l1:l2)*p%r_mn1(l1:l2)
geta_r(:,2)=tmp1*y( m )*p%r_mn1(l1:l2)
geta_r(:,3)=tmp1*z( n )*p%r_mn1(l1:l2)
!
endselect
!
! Debug output (currently only on root processor)
!
if (lroot.and.ldebug) then
print*
print*,'p%r_mn, eta_r, geta_r'
do l=1,nx
write(*,'(1p,5e11.3)') p%r_mn(l),eta_r(l),geta_r(l,:)
enddo
endif
!
endsubroutine eta_rdep
!***********************************************************************
subroutine bb_unitvec_shock(f,bb_hat)
!
! Compute unit vector along the magnetic field.
! Accurate to 2nd order.
! Tries to avoid division by zero.
! Taken from http://nuclear.llnl.gov/CNP/apt/apt/aptvunb.html.
! If anybody knows a more accurate way of doing this, please modify.
!
! 16-aug-06/tobi: coded
! 19-jun-18/fred: added high order option with lbb_as_aux
!
use Sub, only: dot2
!
real, dimension (mx,my,mz,mfarray), intent (in) :: f
real, dimension (mx,3), intent (out) :: bb_hat
!
!Tobi: Not sure about this value
real, parameter :: tol=1e-11
!
real, dimension (mx,3) :: bb,bb2
real, dimension (mx) :: bb_len,aerr2
real :: fac
integer :: j
!
! Compute magnetic field from vector potential.
!
bb=0.
!
if (.not. lbb_as_aux) then
!
if (nxgrid/=1) then
fac = 1/(2*dx)
bb(l1-2:l2+2,3) = bb(l1-2:l2+2,3) + fac*( f(l1-1:l2+3,m ,n ,iay) &
- f(l1-3:l2+1,m ,n ,iay) )
bb(l1-2:l2+2,2) = bb(l1-2:l2+2,2) - fac*( f(l1-1:l2+3,m ,n ,iaz) &
- f(l1-3:l2+1,m ,n ,iaz) )
endif
!
if (nygrid/=1) then
fac = 1/(2*dy)
bb(l1-2:l2+2,1) = bb(l1-2:l2+2,1) + fac*( f(l1-2:l2+2,m+1,n ,iaz) &
- f(l1-2:l2+2,m-1,n ,iaz) )
bb(l1-2:l2+2,3) = bb(l1-2:l2+2,3) - fac*( f(l1-2:l2+2,m+1,n ,iax) &
- f(l1-2:l2+2,m-1,n ,iax) )
endif
!
if (nzgrid/=1) then
fac = 1/(2*dz)
bb(l1-2:l2+2,2) = bb(l1-2:l2+2,2) + fac*( f(l1-2:l2+2,m ,n+1,iax) &
- f(l1-2:l2+2,m ,n-1,iax) )
bb(l1-2:l2+2,1) = bb(l1-2:l2+2,1) - fac*( f(l1-2:l2+2,m ,n+1,iay) &
- f(l1-2:l2+2,m ,n-1,iay) )
endif
!
! Add external magnetic field.
!
do j=1,3; bb(:,j) = bb(:,j) + B_ext(j); enddo
!
! Truncate small components to zero.
!
bb2 = bb**2
!
aerr2 = tol**2 * max(sum(bb2,2),1.)
!
do j=1,3
where (bb2(:,j) < aerr2)
bb_hat(:,j) = 0.
elsewhere
bb_hat(:,j) = bb(:,j)
endwhere
enddo
!
! Get unit vector.
!
bb_len = sqrt(sum(bb_hat**2,2))
!
do j=1,3; bb_hat(:,j) = bb_hat(:,j)/(bb_len+tini); enddo
!
! else if lbb_as_aux
!
else
bb(l1:l2,:) = f(l1:l2,m,n,ibx:ibz)
call dot2(bb(l1:l2,:),bb_len(l1:l2),PRECISE_SQRT=.true.)
aerr2 = tol * max(bb_len,1.)
!
! Truncate small components to zero.
!
do j=1,3
where (bb_len(l1:l2) <= aerr2(l1:l2))
bb_hat(l1:l2,j) = 0.
elsewhere
bb_hat(l1:l2,j) = bb(l1:l2,j)
endwhere
enddo
!
! Get unit vector.
!
do j=1,3; bb_hat(l1:l2,j) = bb_hat(l1:l2,j)/(bb_len(l1:l2)+tini); enddo
!
endif
!
endsubroutine bb_unitvec_shock
!***********************************************************************
subroutine input_persist_magnetic_id(id,done)
!
! Read in the stored phase and amplitude for the correction of the Beltrami
! wave forcing.
!
! 5-apr-08/axel: adapted from input_persist_forcing
! 13-Dec-2011/Bourdin.KIS: reworked
!
use IO, only: read_persist
!
integer :: id
logical :: done
!
select case (id)
case (id_record_MAGNETIC_PHASE)
if (read_persist ('MAGNETIC_PHASE', phase_beltrami)) return
if (lroot) print *, 'input_persist_magnetic: phase_beltrami = ', phase_beltrami
done = .true.
case (id_record_MAGNETIC_AMPL)
if (read_persist ('MAGNETIC_AMPL', ampl_beltrami)) return
if (lroot) print *, 'input_persist_magnetic: ampl_beltrami = ', ampl_beltrami
done = .true.
endselect
!
endsubroutine input_persist_magnetic_id
!***********************************************************************
subroutine input_persist_magnetic()
!
! Read in the stored phase and amplitude for the correction of the Beltrami
! wave forcing.
!
! 12-Oct-2019/PABourdin: coded
!
use IO, only: read_persist
!
logical :: error
!
error = read_persist ('MAGNETIC_PHASE', phase_beltrami)
if (lroot .and. .not. error) print *,'input_persist_magnetic: phase_beltrami = ',phase_beltrami
!
error = read_persist ('MAGNETIC_AMPL', ampl_beltrami)
if (lroot .and. .not. error) print *,'input_persist_magnetic: ampl_beltrami = ',ampl_beltrami
!
endsubroutine input_persist_magnetic
!***********************************************************************
logical function output_persistent_magnetic()
!
! Write the stored phase and amplitude for the
! correction of the Beltrami wave forcing
!
! 5-apr-08/axel: adapted from output_persistent_forcing
! 13-Dec-2011/Bourdin.KIS: reworked
!
use IO, only: write_persist
!
if (lroot .and. (ip < 14) .and. lforcing_cont_aa_local) &
print *, 'output_persistent_magnetic: ', phase_beltrami, ampl_beltrami
!
! write details
!
output_persistent_magnetic = .true.
!
if (lforcing_cont_aa_local) then
if (write_persist ('MAGNETIC_PHASE', id_record_MAGNETIC_PHASE, phase_beltrami)) return
if (write_persist ('MAGNETIC_AMPL', id_record_MAGNETIC_AMPL, ampl_beltrami)) return
endif
!
output_persistent_magnetic = .false.
!
endfunction output_persistent_magnetic
!***********************************************************************
subroutine rprint_magnetic(lreset,lwrite)
!
! Reads and registers print parameters relevant for magnetic fields.
!
! 3-may-02/axel: coded
! 27-may-02/axel: added possibility to reset list
!
use Diagnostics
use Messages, only: warning, fatal_error
!
logical :: lreset
logical, intent(in), optional :: lwrite
!
integer :: iname,inamex,inamey,inamez,ixy,ixz,irz,inamer,iname_half,iname_sound,inamev,idum
!
! Reset everything in case of RELOAD.
! (this needs to be consistent with what is defined above!)
!
if (lreset) then
idiag_eta_tdep=0
idiag_ab_int=0; idiag_jb_int=0; idiag_b2tm=0; idiag_bjtm=0; idiag_jbtm=0
idiag_ubtm=0; idiag_butm=0; idiag_ujtm=0; idiag_jutm=0
idiag_b2uzm=0; idiag_b2ruzm=0; idiag_ubbzm=0
idiag_b1m=0; idiag_b2m=0; idiag_EEM=0; idiag_b4m=0; idiag_b6m=0; idiag_b12m=0
idiag_EEM2=0; idiag_EEM3=0; idiag_EEM4=0
idiag_bm2=0; idiag_j2m=0; idiag_jm2=0
idiag_abm=0; idiag_abrms=0; idiag_jbrms=0; idiag_jxbrms=0; idiag_abmh=0
idiag_gLamam=0; idiag_gLambm=0; idiag_a2b2m=0; idiag_j2b2m=0
idiag_abumx=0; idiag_abumy=0; idiag_abumz=0
idiag_abmn=0; idiag_abms=0; idiag_jbmh=0; idiag_jbmn=0; idiag_jbms=0
idiag_ajm=0; idiag_cosubm=0; idiag_jbm=0; idiag_hjbm=0
idiag_uam=0; idiag_ubm=0; idiag_dubrms=0; idiag_dobrms=0; idiag_ujm=0; idiag_obm=0
idiag_uxbxm=0; idiag_uybxm=0; idiag_uzbxm=0
idiag_uxbym=0; idiag_uybym=0; idiag_uzbym=0
idiag_uxbzm=0; idiag_uybzm=0; idiag_uzbzm=0
idiag_jxbxm=0; idiag_jybxm=0; idiag_jzbxm=0
idiag_jxbym=0; idiag_jybym=0; idiag_jzbym=0
idiag_jxbzm=0; idiag_jybzm=0; idiag_jzbzm=0
idiag_uxjxm=0; idiag_uyjxm=0; idiag_uzjxm=0
idiag_uxjym=0; idiag_uyjym=0; idiag_uzjym=0
idiag_uxjzm=0; idiag_uyjzm=0; idiag_uzjzm=0
idiag_fbm=0; idiag_fxbxm=0; idiag_epsM=0; idiag_epsM_LES=0
idiag_epsM2=0; idiag_epsM3=0; idiag_epsM4=0
idiag_epsAD=0; idiag_epsMmz=0
idiag_bxpt=0; idiag_bypt=0; idiag_bzpt=0
idiag_bxbypt=0; idiag_bybzpt=0; idiag_bzbxpt=0
idiag_jxpt=0; idiag_jypt=0; idiag_jzpt=0
idiag_Expt=0; idiag_Eypt=0; idiag_Ezpt=0
idiag_axpt=0; idiag_aypt=0; idiag_azpt=0
idiag_bxp2=0; idiag_byp2=0; idiag_bzp2=0
idiag_jxp2=0; idiag_jyp2=0; idiag_jzp2=0
idiag_Exp2=0; idiag_Eyp2=0; idiag_Ezp2=0
idiag_axp2=0; idiag_ayp2=0; idiag_azp2=0
idiag_aybym2=0; idiag_exaym2=0; idiag_exjm2=0
idiag_brms=0; idiag_bfrms=0; idiag_bf2m=0; idiag_bf4m=0
idiag_bmax=0; idiag_jrms=0; idiag_jmax=0
idiag_vArms=0; idiag_vA23rms=0; idiag_emag=0; idiag_bxmin=0; idiag_bymin=0; idiag_bzmin=0
idiag_bxmax=0; idiag_bymax=0; idiag_bzmax=0; idiag_vAmax=0; idiag_dtb=0
idiag_dtFr=0;idiag_dtHr=0;idiag_dtBr=0;
idiag_bbxmax=0; idiag_bbymax=0; idiag_bbzmax=0
idiag_jxmax=0; idiag_jymax=0; idiag_jzmax=0
idiag_a2m=0; idiag_arms=0; idiag_amax=0; idiag_beta1m=0; idiag_beta1mz=0
idiag_divarms = 0
idiag_bij_cov_diffmax=0
idiag_beta1max=0; idiag_bxm=0; idiag_bym=0; idiag_bzm=0; idiag_axm=0
idiag_jxm=0; idiag_jym=0; idiag_jzm=0
idiag_betam = 0; idiag_betamax = 0; idiag_betamin = 0
idiag_Azmid_min=0; idiag_Azmid_max=0
idiag_betamz = 0; idiag_beta2mz = 0
idiag_betamx = 0; idiag_beta2mx = 0
idiag_aym=0; idiag_azm=0
idiag_bx2m=0; idiag_by2m=0; idiag_bz2m=0
idiag_bx3m=0; idiag_by3m=0; idiag_bz3m=0
idiag_bx4m=0; idiag_by4m=0; idiag_bz4m=0
idiag_jx2m=0; idiag_jy2m=0; idiag_jz2m=0
idiag_jx4m=0; idiag_jy4m=0; idiag_jz4m=0
idiag_jx2m1=0; idiag_jx2m2=0; idiag_jx2m3=0; idiag_jh2m1=0
idiag_jy2m1=0; idiag_jy2m2=0; idiag_jy2m3=0
idiag_bxbymx = 0; idiag_bxbzmx = 0; idiag_bybzmx = 0
idiag_bxbymy=0; idiag_bxbzmy=0; idiag_bybzmy=0; idiag_bxbymz=0
idiag_aybxmz=0; idiag_ay2mz=0; idiag_bxbzmz=0; idiag_bybzmz=0
idiag_b2mx=0; idiag_a2mz=0; idiag_b2mz=0; idiag_bf2mz=0; idiag_j2mz=0
idiag_jbmz=0; idiag_bdel2amz=0; idiag_jdel2amz=0; idiag_abmz=0; idiag_ubmz=0; idiag_ujmz=0; idiag_obmz=0
idiag_uamz=0; idiag_bzuamz=0; idiag_bzaymz=0
idiag_bzdivamz=0; idiag_bzlammz=0; idiag_divamz=0; idiag_d6abmz=0
idiag_jem=0; idiag_aem=0; idiag_ujxbm=0
idiag_uxbxmz=0; idiag_uybxmz=0; idiag_uzbxmz=0
idiag_uxbymz=0; idiag_uybymz=0; idiag_uzbymz=0
idiag_uxbzmz=0; idiag_uybzmz=0; idiag_uzbzmz=0
idiag_d6amz3=0; idiag_d6amz2=0; idiag_d6amz1=0; idiag_poynzmz=0
idiag_bxbym=0; idiag_bxbzm=0; idiag_bybzm=0; idiag_djuidjbim=0
idiag_axmz=0; idiag_aymz=0; idiag_azmz=0; idiag_bxmz=0; idiag_bymz=0
idiag_jxmz=0; idiag_jymz=0; idiag_jzmz=0
idiag_abuxmz=0; idiag_abuymz=0; idiag_abuzmz=0
idiag_uabxmz=0; idiag_uabymz=0; idiag_uabzmz=0
idiag_bzmz=0; idiag_bmx=0; idiag_bmy=0; idiag_bmz=0; idiag_embmz=0
idiag_km0EM=0; idiag_km1EM=0; idiag_bmzS2=0; idiag_bmzA2=0
idiag_emxamz3=0; idiag_jmx=0; idiag_jmy=0; idiag_jmz=0; idiag_ambmz=0
idiag_jmbmz=0; idiag_kmz=0; idiag_kx_aa=0
idiag_ambmzh=0;idiag_ambmzn=0;idiag_ambmzs=0; idiag_bmzph=0
idiag_bmzphe=0; idiag_bcosphz=0; idiag_bsinphz=0
idiag_bx2mx=0; idiag_by2mx=0; idiag_bz2mx=0
idiag_bx2mz=0; idiag_by2mz=0; idiag_bz2mz=0
idiag_bx2rmz=0; idiag_by2rmz=0; idiag_bz2rmz=0
idiag_bxmxy=0; idiag_bymxy=0; idiag_bzmxy=0
idiag_dbxdxmxy=0; idiag_dbxdymxy=0; idiag_dbxdzmxy=0
idiag_dbydxmxy=0; idiag_dbydymxy=0; idiag_dbydzmxy=0
idiag_dbzdxmxy=0; idiag_dbzdymxy=0; idiag_dbzdzmxy=0
idiag_jxmxy=0; idiag_jymxy=0; idiag_jzmxy=0
idiag_poynxmxy=0; idiag_poynymxy=0; idiag_poynzmxy=0
idiag_bx2mxy=0; idiag_by2mxy=0; idiag_bz2mxy=0; idiag_bxbymxy=0
idiag_examxy1=0; idiag_examxy3=0; idiag_examxy2=0
idiag_bxbzmxy=0; idiag_bybzmxy=0; idiag_bxbymxz=0; idiag_bxbzmxz=0
idiag_Exmz=0 ; idiag_Eymz=0; idiag_Ezmz=0
idiag_Exmxy=0 ; idiag_Eymxy=0; idiag_Ezmxy=0; idiag_beta1mxy=0
idiag_StokesImxy=0; idiag_StokesQmxy=0; idiag_StokesUmxy=0
idiag_StokesQ1mxy=0; idiag_StokesU1mxy=0
idiag_bybzmxz=0; idiag_uybxmxz=0; idiag_uybzmxz=0
idiag_bx1mxz=0; idiag_by1mxz=0; idiag_bz1mxz=0
idiag_bxmxz=0; idiag_bymxz=0; idiag_bzmxz=0; idiag_jbmxy=0
idiag_jxmxz=0; idiag_jymxz=0; idiag_jzmxz=0
idiag_abmxy=0; idiag_b2mxz=0; idiag_ubmxy=0;
idiag_axmxz=0; idiag_aymxz=0; idiag_azmxz=0; idiag_Exmxz=0
idiag_axmxy=0; idiag_aymxy=0; idiag_azmxy=0
idiag_Eymxz=0; idiag_Ezmxz=0; idiag_jxbm=0; idiag_uxbm=0; idiag_oxuxbm=0
idiag_jxbxbm=0; idiag_gpxbm=0; idiag_uxDxuxbm=0; idiag_vAmxz=0
idiag_uxbmx=0; idiag_uxbmy=0; idiag_uxbmz=0
idiag_jxbmx=0; idiag_jxbmy=0; idiag_jxbmz=0
idiag_uxbcmx=0; idiag_uxbsmx=0
idiag_uxbcmy=0; idiag_uxbsmy=0; idiag_examz1=0; idiag_examz2=0
idiag_examz3=0; idiag_examx=0; idiag_examy=0; idiag_examz=0
idiag_exatotalmz1=0;idiag_exatotalmz2=0; idiag_exatotalmz3=0
idiag_exatotalmx=0; idiag_exatotalmy=0; idiag_exatotalmz=0
idiag_e3xamz1=0; idiag_e3xamz2=0; idiag_e3xamz3=0
idiag_exjmx=0; idiag_exjmy=0; idiag_exjmz=0; idiag_dexbmx=0
idiag_dexbmy=0; idiag_dexbmz=0; idiag_phibmx=0; idiag_phibmy=0
idiag_phibmz=0; idiag_uxjm=0; idiag_jdel2am=0
idiag_ujxbm=0; idiag_ugb22m=0; idiag_ubgbpm=0; idiag_b2divum=0
idiag_WL2D=0; idiag_WL3D=0; idiag_WL3D2=0; idiag_bij2m=0; idiag_sijbibjm=0
idiag_b3b21m=0; idiag_b3b12m=0; idiag_b1b32m=0; idiag_b1b23m=0
idiag_b2b13m=0 ; idiag_b2b31m=0
idiag_udotxbm=0; idiag_uxbdotm=0; idiag_brmphi=0; idiag_bpmphi=0
idiag_bzmphi=0; idiag_b2mphi=0; idiag_jbmphi=0; idiag_uxbrmphi=0
idiag_uxbpmphi=0; idiag_uxbzmphi=0; idiag_jxbrmphi=0; idiag_jxbpmphi=0
idiag_jxbzmphi=0; idiag_jxbrxm=0; idiag_jxbrym=0; idiag_jxbrzm=0; idiag_jxbrqm=0
idiag_jxbr2m=0; idiag_jxbrxmx=0; idiag_jxbrymx=0; idiag_jxbrzmx=0; idiag_jxbrmax=0
idiag_jxbrxmy=0; idiag_jxbrymy=0; idiag_jxbrzmy=0; idiag_jxbrxmz=0
idiag_jxbrymz=0; idiag_jxbrzmz=0; idiag_armphi=0; idiag_apmphi=0
idiag_azmphi=0; idiag_dteta=0; idiag_uxBrms=0; idiag_Bresrms=0
idiag_Rmrms=0; idiag_jfm=0; idiag_brbpmr=0; idiag_va2m=0; idiag_b2mr=0
idiag_brmr=0; idiag_bpmr=0; idiag_bzmr=0; idiag_armr=0; idiag_apmr=0
idiag_azmr=0; idiag_bxmx=0; idiag_bymx=0; idiag_bzmx=0; idiag_bxmy=0
idiag_bymy=0; idiag_bzmy=0; idiag_bx2my=0; idiag_by2my=0; idiag_bz2my=0
idiag_mflux_x=0; idiag_mflux_y=0; idiag_mflux_z=0; idiag_bmxy_rms=0
idiag_brsphmphi=0; idiag_bthmphi=0; idiag_brmsh=0; idiag_brmsn=0
idiag_br2mphi=0; idiag_bp2mphi=0; idiag_bz2mphi=0
idiag_brbpmphi=0; idiag_brbzmphi=0; idiag_bpbzmphi=0
idiag_brmss=0; idiag_etatotalmx=0; idiag_etatotalmz=0; idiag_Rmmz=0
idiag_brmsx=0; idiag_brmsz=0
idiag_etavamax=0; idiag_etajmax=0; idiag_etaj2max=0; idiag_etajrhomax=0
idiag_hjrms=0;idiag_hjbm=0;idiag_coshjbm=0
idiag_etasmagm=0; idiag_etaaniso=0; idiag_etaanisoBB=0
idiag_cosjbm=0; idiag_jparallelm=0; idiag_jperpm=0
idiag_hjparallelm=0; idiag_hjperpm=0
idiag_vmagfricmax=0; idiag_vmagfricrms=0; idiag_vmagfricmz=0
ivid_aps=0; ivid_bb=0; ivid_jj=0; ivid_b2=0; ivid_j2=0; ivid_ab=0
ivid_jb=0; ivid_beta1=0; ivid_poynting=0; ivid_bb_sph=0; idiag_dteta3=0
idiag_b2sphm=0; idiag_bxph1mz=0; idiag_bxph2mz=0; idiag_bxph3mz=0
idiag_byph1mz=0; idiag_byph2mz=0; idiag_byph3mz=0
idiag_bzph1mz=0; idiag_bzph2mz=0; idiag_bzph3mz=0
idiag_bx2ph1mz=0; idiag_bx2ph2mz=0; idiag_bx2ph3mz=0
idiag_by2ph1mz=0; idiag_by2ph2mz=0; idiag_by2ph3mz=0
idiag_bz2ph1mz=0; idiag_bz2ph2mz=0; idiag_bz2ph3mz=0
idiag_bx2rph1mz=0; idiag_bx2rph2mz=0; idiag_bx2rph3mz=0
idiag_by2rph1mz=0; idiag_by2rph2mz=0; idiag_by2rph3mz=0
idiag_bz2rph1mz=0; idiag_bz2rph2mz=0; idiag_bz2rph3mz=0
idiag_abph1mz=0; idiag_abph2mz=0; idiag_abph3mz=0
idiag_jbph1mz=0; idiag_jbph2mz=0; idiag_jbph3mz=0
idiag_poynzph1mz=0; idiag_poynzph2mz=0; idiag_poynzph3mz=0
idiag_jxph1mz=0; idiag_jyph1mz=0; idiag_jzph1mz=0
idiag_jxph2mz=0; idiag_jyph2mz=0; idiag_jzph2mz=0
idiag_jxph3mz=0; idiag_jyph3mz=0; idiag_jzph3mz=0
endif
!
! Check for those quantities that we want to evaluate online.
!
do iname=1,nname
call parse_name(iname,cname(iname),cform(iname),'eta_tdep',idiag_eta_tdep)
call parse_name(iname,cname(iname),cform(iname),'ab_int',idiag_ab_int)
call parse_name(iname,cname(iname),cform(iname),'jb_int',idiag_jb_int)
call parse_name(iname,cname(iname),cform(iname),'dteta',idiag_dteta)
call parse_name(iname,cname(iname),cform(iname),'dteta3',idiag_dteta3)
call parse_name(iname,cname(iname),cform(iname),'aybym2',idiag_aybym2)
call parse_name(iname,cname(iname),cform(iname),'exaym2',idiag_exaym2)
call parse_name(iname,cname(iname),cform(iname),'exabot',idiag_exabot)
call parse_name(iname,cname(iname),cform(iname),'exatop',idiag_exatop)
call parse_name(iname,cname(iname),cform(iname),'exjm2',idiag_exjm2)
call parse_name(iname,cname(iname),cform(iname),'b2tm',idiag_b2tm)
call parse_name(iname,cname(iname),cform(iname),'bjtm',idiag_bjtm)
call parse_name(iname,cname(iname),cform(iname),'jbtm',idiag_jbtm)
call parse_name(iname,cname(iname),cform(iname),'ujtm',idiag_ujtm)
call parse_name(iname,cname(iname),cform(iname),'jutm',idiag_jutm)
call parse_name(iname,cname(iname),cform(iname),'ubtm',idiag_ubtm)
call parse_name(iname,cname(iname),cform(iname),'butm',idiag_butm)
call parse_name(iname,cname(iname),cform(iname),'abm',idiag_abm)
call parse_name(iname,cname(iname),cform(iname),'gLamam',idiag_gLamam)
call parse_name(iname,cname(iname),cform(iname),'gLambm',idiag_gLambm)
call parse_name(iname,cname(iname),cform(iname),'a2b2m',idiag_a2b2m)
call parse_name(iname,cname(iname),cform(iname),'j2b2m',idiag_j2b2m)
call parse_name(iname,cname(iname),cform(iname),'abmn',idiag_abmn)
call parse_name(iname,cname(iname),cform(iname),'abms',idiag_abms)
call parse_name(iname,cname(iname),cform(iname),'abrms',idiag_abrms)
call parse_name(iname,cname(iname),cform(iname),'jbrms',idiag_jbrms)
call parse_name(iname,cname(iname),cform(iname),'jxbrms',idiag_jxbrms)
call parse_name(iname,cname(iname),cform(iname),'abumx',idiag_abumx)
call parse_name(iname,cname(iname),cform(iname),'abumy',idiag_abumy)
call parse_name(iname,cname(iname),cform(iname),'abumz',idiag_abumz)
call parse_name(iname,cname(iname),cform(iname),'ajm',idiag_ajm)
call parse_name(iname,cname(iname),cform(iname),'jbm',idiag_jbm)
call parse_name(iname,cname(iname),cform(iname),'hjbm',idiag_hjbm)
call parse_name(iname,cname(iname),cform(iname),'jbmn',idiag_jbmn)
call parse_name(iname,cname(iname),cform(iname),'jbms',idiag_jbms)
call parse_name(iname,cname(iname),cform(iname),'ubm',idiag_ubm)
call parse_name(iname,cname(iname),cform(iname),'dubrms',idiag_dubrms)
call parse_name(iname,cname(iname),cform(iname),'dobrms',idiag_dobrms)
call parse_name(iname,cname(iname),cform(iname),'uxbxm',idiag_uxbxm)
call parse_name(iname,cname(iname),cform(iname),'uybxm',idiag_uybxm)
call parse_name(iname,cname(iname),cform(iname),'uzbxm',idiag_uzbxm)
call parse_name(iname,cname(iname),cform(iname),'uxbym',idiag_uxbym)
call parse_name(iname,cname(iname),cform(iname),'uybym',idiag_uybym)
call parse_name(iname,cname(iname),cform(iname),'uzbym',idiag_uzbym)
call parse_name(iname,cname(iname),cform(iname),'uxbzm',idiag_uxbzm)
call parse_name(iname,cname(iname),cform(iname),'uybzm',idiag_uybzm)
call parse_name(iname,cname(iname),cform(iname),'uzbzm',idiag_uzbzm)
call parse_name(iname,cname(iname),cform(iname),'uxjxm',idiag_uxjxm)
call parse_name(iname,cname(iname),cform(iname),'uyjxm',idiag_uyjxm)
call parse_name(iname,cname(iname),cform(iname),'uzjxm',idiag_uzjxm)
call parse_name(iname,cname(iname),cform(iname),'uxjym',idiag_uxjym)
call parse_name(iname,cname(iname),cform(iname),'uyjym',idiag_uyjym)
call parse_name(iname,cname(iname),cform(iname),'uzjym',idiag_uzjym)
call parse_name(iname,cname(iname),cform(iname),'uxjzm',idiag_uxjzm)
call parse_name(iname,cname(iname),cform(iname),'uyjzm',idiag_uyjzm)
call parse_name(iname,cname(iname),cform(iname),'uzjzm',idiag_uzjzm)
call parse_name(iname,cname(iname),cform(iname),'cosubm',idiag_cosubm)
call parse_name(iname,cname(iname),cform(iname),'jxbxm',idiag_jxbxm)
call parse_name(iname,cname(iname),cform(iname),'jybxm',idiag_jybxm)
call parse_name(iname,cname(iname),cform(iname),'jzbxm',idiag_jzbxm)
call parse_name(iname,cname(iname),cform(iname),'jxbym',idiag_jxbym)
call parse_name(iname,cname(iname),cform(iname),'jybym',idiag_jybym)
call parse_name(iname,cname(iname),cform(iname),'jzbym',idiag_jzbym)
call parse_name(iname,cname(iname),cform(iname),'jxbzm',idiag_jxbzm)
call parse_name(iname,cname(iname),cform(iname),'jybzm',idiag_jybzm)
call parse_name(iname,cname(iname),cform(iname),'jzbzm',idiag_jzbzm)
call parse_name(iname,cname(iname),cform(iname),'uam',idiag_uam)
call parse_name(iname,cname(iname),cform(iname),'obm',idiag_obm)
call parse_name(iname,cname(iname),cform(iname),'ujm',idiag_ujm)
call parse_name(iname,cname(iname),cform(iname),'fbm',idiag_fbm)
call parse_name(iname,cname(iname),cform(iname),'fxbxm',idiag_fxbxm)
call parse_name(iname,cname(iname),cform(iname),'b2ruzm',idiag_b2ruzm)
call parse_name(iname,cname(iname),cform(iname),'b2uzm',idiag_b2uzm)
call parse_name(iname,cname(iname),cform(iname),'ubbzm',idiag_ubbzm)
call parse_name(iname,cname(iname),cform(iname),'b1m',idiag_b1m)
call parse_name(iname,cname(iname),cform(iname),'b2m',idiag_b2m)
call parse_name(iname,cname(iname),cform(iname),'EEM',idiag_EEM)
call parse_name(iname,cname(iname),cform(iname),'EEM2',idiag_EEM2)
call parse_name(iname,cname(iname),cform(iname),'EEM3',idiag_EEM3)
call parse_name(iname,cname(iname),cform(iname),'EEM4',idiag_EEM4)
call parse_name(iname,cname(iname),cform(iname),'b4m',idiag_b4m)
call parse_name(iname,cname(iname),cform(iname),'b6m',idiag_b6m)
call parse_name(iname,cname(iname),cform(iname),'b12m',idiag_b12m)
call parse_name(iname,cname(iname),cform(iname),'bm2',idiag_bm2)
call parse_name(iname,cname(iname),cform(iname),'j2m',idiag_j2m)
call parse_name(iname,cname(iname),cform(iname),'jm2',idiag_jm2)
call parse_name(iname,cname(iname),cform(iname),'epsM',idiag_epsM)
call parse_name(iname,cname(iname),cform(iname),'epsM2',idiag_epsM2)
call parse_name(iname,cname(iname),cform(iname),'epsM3',idiag_epsM3)
call parse_name(iname,cname(iname),cform(iname),'epsM4',idiag_epsM4)
call parse_name(iname,cname(iname),cform(iname),'epsM_LES',idiag_epsM_LES)
call parse_name(iname,cname(iname),cform(iname),'epsAD',idiag_epsAD)
call parse_name(iname,cname(iname),cform(iname),'emag',idiag_emag)
call parse_name(iname,cname(iname),cform(iname),'brms',idiag_brms)
call parse_name(iname,cname(iname),cform(iname),'bfrms',idiag_bfrms)
call parse_name(iname,cname(iname),cform(iname),'bf2m',idiag_bf2m)
call parse_name(iname,cname(iname),cform(iname),'bf4m',idiag_bf4m)
call parse_name(iname,cname(iname),cform(iname),'brmsn',idiag_brmsn)
call parse_name(iname,cname(iname),cform(iname),'brmss',idiag_brmss)
call parse_name(iname,cname(iname),cform(iname),'brmsx',idiag_brmsx)
call parse_name(iname,cname(iname),cform(iname),'brmsz',idiag_brmsz)
call parse_name(iname,cname(iname),cform(iname),'bmax',idiag_bmax)
call parse_name(iname,cname(iname),cform(iname),'bxmin',idiag_bxmin)
call parse_name(iname,cname(iname),cform(iname),'bymin',idiag_bymin)
call parse_name(iname,cname(iname),cform(iname),'bzmin',idiag_bzmin)
call parse_name(iname,cname(iname),cform(iname),'bxmax',idiag_bxmax)
call parse_name(iname,cname(iname),cform(iname),'bymax',idiag_bymax)
call parse_name(iname,cname(iname),cform(iname),'bzmax',idiag_bzmax)
call parse_name(iname,cname(iname),cform(iname),'bbxmax',idiag_bbxmax)
call parse_name(iname,cname(iname),cform(iname),'bbymax',idiag_bbymax)
call parse_name(iname,cname(iname),cform(iname),'bbzmax',idiag_bbzmax)
call parse_name(iname,cname(iname),cform(iname),'jxmax',idiag_jxmax)
call parse_name(iname,cname(iname),cform(iname),'jymax',idiag_jymax)
call parse_name(iname,cname(iname),cform(iname),'jzmax',idiag_jzmax)
call parse_name(iname,cname(iname),cform(iname),'jrms',idiag_jrms)
call parse_name(iname,cname(iname),cform(iname),'hjrms',idiag_hjrms)
call parse_name(iname,cname(iname),cform(iname),'jmax',idiag_jmax)
call parse_name(iname,cname(iname),cform(iname),'axm',idiag_axm)
call parse_name(iname,cname(iname),cform(iname),'aym',idiag_aym)
call parse_name(iname,cname(iname),cform(iname),'azm',idiag_azm)
call parse_name(iname,cname(iname),cform(iname),'a2m',idiag_a2m)
call parse_name(iname,cname(iname),cform(iname),'arms',idiag_arms)
call parse_name(iname,cname(iname),cform(iname),'amax',idiag_amax)
call parse_name(iname,cname(iname),cform(iname),'divarms',idiag_divarms)
call parse_name(iname,cname(iname),cform(iname),'vArms',idiag_vArms)
call parse_name(iname,cname(iname),cform(iname),'vA23rms',idiag_vA23rms)
call parse_name(iname,cname(iname),cform(iname),'vAmax',idiag_vAmax)
call parse_name(iname,cname(iname),cform(iname),'vA2m',idiag_vA2m)
call parse_name(iname,cname(iname),cform(iname),'beta1m',idiag_beta1m)
call parse_name(iname,cname(iname),cform(iname),'beta1max',idiag_beta1max)
call parse_name(iname,cname(iname),cform(iname),'betam',idiag_betam)
call parse_name(iname,cname(iname),cform(iname),'betamax',idiag_betamax)
call parse_name(iname,cname(iname),cform(iname),'betamin',idiag_betamin)
call parse_name(iname,cname(iname),cform(iname),'Azmid_min',idiag_Azmid_min)
call parse_name(iname,cname(iname),cform(iname),'Azmid_max',idiag_Azmid_max)
call parse_name(iname,cname(iname),cform(iname),'dtb',idiag_dtb)
call parse_name(iname,cname(iname),cform(iname),'dtHr',idiag_dtHr)
call parse_name(iname,cname(iname),cform(iname),'dtFr',idiag_dtFr)
call parse_name(iname,cname(iname),cform(iname),'dtBr',idiag_dtBr)
call parse_name(iname,cname(iname),cform(iname),'bxm',idiag_bxm)
call parse_name(iname,cname(iname),cform(iname),'bym',idiag_bym)
call parse_name(iname,cname(iname),cform(iname),'bzm',idiag_bzm)
call parse_name(iname,cname(iname),cform(iname),'jxm',idiag_jxm)
call parse_name(iname,cname(iname),cform(iname),'jym',idiag_jym)
call parse_name(iname,cname(iname),cform(iname),'jzm',idiag_jzm)
call parse_name(iname,cname(iname),cform(iname),'bx2m',idiag_bx2m)
call parse_name(iname,cname(iname),cform(iname),'by2m',idiag_by2m)
call parse_name(iname,cname(iname),cform(iname),'bz2m',idiag_bz2m)
call parse_name(iname,cname(iname),cform(iname),'bx3m',idiag_bx3m)
call parse_name(iname,cname(iname),cform(iname),'by3m',idiag_by3m)
call parse_name(iname,cname(iname),cform(iname),'bz3m',idiag_bz3m)
call parse_name(iname,cname(iname),cform(iname),'bx4m',idiag_bx4m)
call parse_name(iname,cname(iname),cform(iname),'by4m',idiag_by4m)
call parse_name(iname,cname(iname),cform(iname),'bz4m',idiag_bz4m)
call parse_name(iname,cname(iname),cform(iname),'jx2m',idiag_jx2m)
call parse_name(iname,cname(iname),cform(iname),'jy2m',idiag_jy2m)
call parse_name(iname,cname(iname),cform(iname),'jz2m',idiag_jz2m)
call parse_name(iname,cname(iname),cform(iname),'jx4m',idiag_jx4m)
call parse_name(iname,cname(iname),cform(iname),'jy4m',idiag_jy4m)
call parse_name(iname,cname(iname),cform(iname),'jz4m',idiag_jz4m)
call parse_name(iname,cname(iname),cform(iname),'jh2m1',idiag_jh2m1)
call parse_name(iname,cname(iname),cform(iname),'jx2m1',idiag_jx2m1)
call parse_name(iname,cname(iname),cform(iname),'jy2m1',idiag_jy2m1)
call parse_name(iname,cname(iname),cform(iname),'jx2m2',idiag_jx2m2)
call parse_name(iname,cname(iname),cform(iname),'jy2m2',idiag_jy2m2)
call parse_name(iname,cname(iname),cform(iname),'jx2m3',idiag_jx2m3)
call parse_name(iname,cname(iname),cform(iname),'jy2m3',idiag_jy2m3)
call parse_name(iname,cname(iname),cform(iname),'bxbym',idiag_bxbym)
call parse_name(iname,cname(iname),cform(iname),'bxbzm',idiag_bxbzm)
call parse_name(iname,cname(iname),cform(iname),'bybzm',idiag_bybzm)
call parse_name(iname,cname(iname),cform(iname),'djuidjbim',idiag_djuidjbim)
call parse_name(iname,cname(iname),cform(iname),'bij_cov_diffmax',idiag_bij_cov_diffmax)
call parse_name(iname,cname(iname),cform(iname),'jxbrxm',idiag_jxbrxm)
call parse_name(iname,cname(iname),cform(iname),'jxbrym',idiag_jxbrym)
call parse_name(iname,cname(iname),cform(iname),'jxbrzm',idiag_jxbrzm)
call parse_name(iname,cname(iname),cform(iname),'jxbrqm',idiag_jxbrqm)
call parse_name(iname,cname(iname),cform(iname),'jxbrmax',idiag_jxbrmax)
call parse_name(iname,cname(iname),cform(iname),'jxbr2m',idiag_jxbr2m)
call parse_name(iname,cname(iname),cform(iname),'jxbm',idiag_jxbm)
call parse_name(iname,cname(iname),cform(iname),'uxbm',idiag_uxbm)
call parse_name(iname,cname(iname),cform(iname),'uxbmx',idiag_uxbmx)
call parse_name(iname,cname(iname),cform(iname),'uxbmy',idiag_uxbmy)
call parse_name(iname,cname(iname),cform(iname),'uxbmz',idiag_uxbmz)
call parse_name(iname,cname(iname),cform(iname),'jxbmx',idiag_jxbmx)
call parse_name(iname,cname(iname),cform(iname),'jxbmy',idiag_jxbmy)
call parse_name(iname,cname(iname),cform(iname),'jxbmz',idiag_jxbmz)
call parse_name(iname,cname(iname),cform(iname),'vmagfricmax',idiag_vmagfricmax)
call parse_name(iname,cname(iname),cform(iname),'vmagfricrms',idiag_vmagfricrms)
call parse_name(iname,cname(iname),cform(iname),'uxbcmx',idiag_uxbcmx)
call parse_name(iname,cname(iname),cform(iname),'uxbcmy',idiag_uxbcmy)
call parse_name(iname,cname(iname),cform(iname),'uxbsmx',idiag_uxbsmx)
call parse_name(iname,cname(iname),cform(iname),'uxbsmy',idiag_uxbsmy)
call parse_name(iname,cname(iname),cform(iname),'examx',idiag_examx)
call parse_name(iname,cname(iname),cform(iname),'examy',idiag_examy)
call parse_name(iname,cname(iname),cform(iname),'examz',idiag_examz)
call parse_name(iname,cname(iname),cform(iname),'exatotalmx',idiag_exatotalmx)
call parse_name(iname,cname(iname),cform(iname),'exatotalmy',idiag_exatotalmy)
call parse_name(iname,cname(iname),cform(iname),'exatotalmz',idiag_exatotalmz)
call parse_name(iname,cname(iname),cform(iname),'exjmx',idiag_exjmx)
call parse_name(iname,cname(iname),cform(iname),'exjmy',idiag_exjmy)
call parse_name(iname,cname(iname),cform(iname),'exjmz',idiag_exjmz)
call parse_name(iname,cname(iname),cform(iname),'dexbmx',idiag_dexbmx)
call parse_name(iname,cname(iname),cform(iname),'dexbmy',idiag_dexbmy)
call parse_name(iname,cname(iname),cform(iname),'dexbmz',idiag_dexbmz)
call parse_name(iname,cname(iname),cform(iname),'phibmx',idiag_phibmx)
call parse_name(iname,cname(iname),cform(iname),'phibmy',idiag_phibmy)
call parse_name(iname,cname(iname),cform(iname),'phibmz',idiag_phibmz)
call parse_name(iname,cname(iname),cform(iname),'uxjm',idiag_uxjm)
call parse_name(iname,cname(iname),cform(iname),'jdel2am',idiag_jdel2am)
call parse_name(iname,cname(iname),cform(iname),'jem',idiag_jem)
call parse_name(iname,cname(iname),cform(iname),'aem',idiag_aem)
call parse_name(iname,cname(iname),cform(iname),'ujxbm',idiag_ujxbm)
call parse_name(iname,cname(iname),cform(iname),'WL2D',idiag_WL2D)
call parse_name(iname,cname(iname),cform(iname),'WL3D',idiag_WL3D)
call parse_name(iname,cname(iname),cform(iname),'WL3D2',idiag_WL3D2)
call parse_name(iname,cname(iname),cform(iname),'bij2m',idiag_bij2m)
call parse_name(iname,cname(iname),cform(iname),'sijbibjm',idiag_sijbibjm)
call parse_name(iname,cname(iname),cform(iname),'ubgbpm',idiag_ubgbpm)
call parse_name(iname,cname(iname),cform(iname),'ugb22m',idiag_ugb22m)
call parse_name(iname,cname(iname),cform(iname),'b2divum',idiag_b2divum)
call parse_name(iname,cname(iname),cform(iname),'jxbxbm',idiag_jxbxbm)
call parse_name(iname,cname(iname),cform(iname),'oxuxbm',idiag_oxuxbm)
call parse_name(iname,cname(iname),cform(iname),'gpxbm',idiag_gpxbm)
call parse_name(iname,cname(iname),cform(iname),'uxDxuxbm',idiag_uxDxuxbm)
call parse_name(iname,cname(iname),cform(iname),'b3b21m',idiag_b3b21m)
call parse_name(iname,cname(iname),cform(iname),'b3b12m',idiag_b3b12m)
call parse_name(iname,cname(iname),cform(iname),'b1b32m',idiag_b1b32m)
call parse_name(iname,cname(iname),cform(iname),'b1b23m',idiag_b1b23m)
call parse_name(iname,cname(iname),cform(iname),'b2b13m',idiag_b2b13m)
call parse_name(iname,cname(iname),cform(iname),'b2b31m',idiag_b2b31m)
call parse_name(iname,cname(iname),cform(iname),'udotxbm',idiag_udotxbm)
call parse_name(iname,cname(iname),cform(iname),'uxbdotm',idiag_uxbdotm)
call parse_name(iname,cname(iname),cform(iname),'km0EM',idiag_km0EM)
call parse_name(iname,cname(iname),cform(iname),'km1EM',idiag_km1EM)
call parse_name(iname,cname(iname),cform(iname),'bmx',idiag_bmx)
call parse_name(iname,cname(iname),cform(iname),'bmy',idiag_bmy)
call parse_name(iname,cname(iname),cform(iname),'bmz',idiag_bmz)
call parse_name(iname,cname(iname),cform(iname),'bmzS2',idiag_bmzS2)
call parse_name(iname,cname(iname),cform(iname),'bmzA2',idiag_bmzA2)
call parse_name(iname,cname(iname),cform(iname),'jmx',idiag_jmx)
call parse_name(iname,cname(iname),cform(iname),'jmy',idiag_jmy)
call parse_name(iname,cname(iname),cform(iname),'jmz',idiag_jmz)
call parse_name(iname,cname(iname),cform(iname),'bmzph',idiag_bmzph)
call parse_name(iname,cname(iname),cform(iname),'bmzphe',idiag_bmzphe)
call parse_name(iname,cname(iname),cform(iname),'bcosphz',idiag_bcosphz)
call parse_name(iname,cname(iname),cform(iname),'bsinphz',idiag_bsinphz)
call parse_name(iname,cname(iname),cform(iname),'emxamz3',idiag_emxamz3)
call parse_name(iname,cname(iname),cform(iname),'embmz',idiag_embmz)
call parse_name(iname,cname(iname),cform(iname),'ambmz',idiag_ambmz)
call parse_name(iname,cname(iname),cform(iname),'ambmzn',idiag_ambmzn)
call parse_name(iname,cname(iname),cform(iname),'ambmzs',idiag_ambmzs)
call parse_name(iname,cname(iname),cform(iname),'jmbmz',idiag_jmbmz)
call parse_name(iname,cname(iname),cform(iname),'kmz',idiag_kmz)
call parse_name(iname,cname(iname),cform(iname),'kx_aa',idiag_kx_aa)
call parse_name(iname,cname(iname),cform(iname),'bxpt',idiag_bxpt)
call parse_name(iname,cname(iname),cform(iname),'bypt',idiag_bypt)
call parse_name(iname,cname(iname),cform(iname),'bzpt',idiag_bzpt)
call parse_name(iname,cname(iname),cform(iname),'bxbypt',idiag_bxbypt)
call parse_name(iname,cname(iname),cform(iname),'bybzpt',idiag_bybzpt)
call parse_name(iname,cname(iname),cform(iname),'bzbxpt',idiag_bzbxpt)
call parse_name(iname,cname(iname),cform(iname),'jxpt',idiag_jxpt)
call parse_name(iname,cname(iname),cform(iname),'jypt',idiag_jypt)
call parse_name(iname,cname(iname),cform(iname),'jzpt',idiag_jzpt)
call parse_name(iname,cname(iname),cform(iname),'Expt',idiag_Expt)
call parse_name(iname,cname(iname),cform(iname),'Eypt',idiag_Eypt)
call parse_name(iname,cname(iname),cform(iname),'Ezpt',idiag_Ezpt)
call parse_name(iname,cname(iname),cform(iname),'axpt',idiag_axpt)
call parse_name(iname,cname(iname),cform(iname),'aypt',idiag_aypt)
call parse_name(iname,cname(iname),cform(iname),'azpt',idiag_azpt)
call parse_name(iname,cname(iname),cform(iname),'bxp2',idiag_bxp2)
call parse_name(iname,cname(iname),cform(iname),'byp2',idiag_byp2)
call parse_name(iname,cname(iname),cform(iname),'bzp2',idiag_bzp2)
call parse_name(iname,cname(iname),cform(iname),'jxp2',idiag_jxp2)
call parse_name(iname,cname(iname),cform(iname),'jyp2',idiag_jyp2)
call parse_name(iname,cname(iname),cform(iname),'jzp2',idiag_jzp2)
call parse_name(iname,cname(iname),cform(iname),'Exp2',idiag_Exp2)
call parse_name(iname,cname(iname),cform(iname),'Eyp2',idiag_Eyp2)
call parse_name(iname,cname(iname),cform(iname),'Ezp2',idiag_Ezp2)
call parse_name(iname,cname(iname),cform(iname),'axp2',idiag_axp2)
call parse_name(iname,cname(iname),cform(iname),'ayp2',idiag_ayp2)
call parse_name(iname,cname(iname),cform(iname),'azp2',idiag_azp2)
call parse_name(iname,cname(iname),cform(iname),'uxBrms',idiag_uxBrms)
call parse_name(iname,cname(iname),cform(iname),'Bresrms',idiag_Bresrms)
call parse_name(iname,cname(iname),cform(iname),'Rmrms',idiag_Rmrms)
call parse_name(iname,cname(iname),cform(iname),'jfm',idiag_jfm)
call parse_name(iname,cname(iname),cform(iname),'bmxy_rms',idiag_bmxy_rms)
call parse_name(iname,cname(iname),cform(iname),'etasmagm',idiag_etasmagm)
call parse_name(iname,cname(iname),cform(iname),'etasmagmin',idiag_etasmagmin)
call parse_name(iname,cname(iname),cform(iname),'etasmagmax',idiag_etasmagmax)
call parse_name(iname,cname(iname),cform(iname),'etavamax',idiag_etavamax)
call parse_name(iname,cname(iname),cform(iname),'etajmax',idiag_etajmax)
call parse_name(iname,cname(iname),cform(iname),'etaj2max',idiag_etaj2max)
call parse_name(iname,cname(iname),cform(iname),'etajrhomax',idiag_etajrhomax)
call parse_name(iname,cname(iname),cform(iname),'etaaniso',idiag_etaaniso)
call parse_name(iname,cname(iname),cform(iname),'etaanisoBB',idiag_etaanisoBB)
call parse_name(iname,cname(iname),cform(iname),'cosjbm',idiag_cosjbm)
call parse_name(iname,cname(iname),cform(iname),'jparallelm',idiag_jparallelm)
call parse_name(iname,cname(iname),cform(iname),'jperpm',idiag_jperpm)
call parse_name(iname,cname(iname),cform(iname),'coshjbm',idiag_coshjbm)
call parse_name(iname,cname(iname),cform(iname),'hjparallelm',idiag_hjparallelm)
call parse_name(iname,cname(iname),cform(iname),'hjperpm',idiag_hjperpm)
call parse_name(iname,cname(iname),cform(iname),'b2sphm',idiag_b2sphm)
enddo
!
if (idiag_exabot/=0) call set_type(idiag_exabot,lint=.true.)
if (idiag_exatop/=0) call set_type(idiag_exatop,lint=.true.)
!
if (lactive_dimension(3)) idiag_bij_cov_diffmax=0
if (idiag_b2tm/=0) then
if (ibbt==0) call fatal_error('rprint_magnetic',"Cannot calculate b2tm if ibbt==0")
idiag_b2tm=0
endif
if (idiag_jbtm/=0) then
if (ibbt==0) call fatal_error('rprint_magnetic',"Cannot calculate jbtm if ibbt==0")
idiag_jbtm=0
endif
if (idiag_bjtm/=0) then
if (ijjt==0) call fatal_error('rprint_magnetic',"Cannot calculate bjtm if ijjt==0")
idiag_bjtm=0
endif
if (idiag_jutm/=0) then
if (iuut==0) call fatal_error('rprint_magnetic',"Cannot calculate jutm if iuut==0")
endif
if (idiag_ujtm/=0) then
if (ijjt==0) call fatal_error('rprint_magnetic',"Cannot calculate ujtm if ijjt==0")
endif
if (idiag_butm/=0) then
if (iuut==0) call fatal_error('rprint_magnetic',"Cannot calculate butm if iuut==0")
endif
if (idiag_ubtm/=0) then
if (ibbt==0) call fatal_error('rprint_magnetic',"Cannot calculate ubtm if ibbt==0")
endif
!
if (.not.lentropy) idiag_dtHr=0
if (.not.lhydro) idiag_dtFr=0
!
! Quantities which are averaged over half (north-south) the box.
!
iname_half=name_half_max
!
! Magnetic helicity (north and south) of total field.
!
if ((idiag_abmn/=0).or.(idiag_abms/=0)) then
iname_half=iname_half+1
idiag_abmh=iname_half
endif
!
! Current helicity (north and south) of total field.
!
if ((idiag_jbmn/=0).or.(idiag_jbms/=0)) then
iname_half=iname_half+1
idiag_jbmh=iname_half
endif
!
! Magnetic energy (north and south) of total field.
!
if ((idiag_brmsn/=0).or.(idiag_brmss/=0)) then
iname_half=iname_half+1
idiag_brmsh=iname_half
endif
!
! Magnetic helicity (north and south) of mean field.
!
if ((idiag_ambmzn/=0).or.(idiag_ambmzs/=0)) then
iname_half=iname_half+1
idiag_ambmzh=iname_half
endif
!
! Update name_half_max.
!
name_half_max=iname_half
!
! Currently need to force zaverage calculation at every lout step for
! bmx and bmy and bmxy_rms.
!
if ((idiag_bmx+idiag_bmy+idiag_bmxy_rms)>0) ldiagnos_need_zaverages=.true.
!
! Check for those quantities for which we want yz-averages.
!
do inamex=1,nnamex
call parse_name(inamex,cnamex(inamex),cformx(inamex),'b2mx',idiag_b2mx)
call parse_name(inamex,cnamex(inamex),cformx(inamex),'bxmx',idiag_bxmx)
call parse_name(inamex,cnamex(inamex),cformx(inamex),'bymx',idiag_bymx)
call parse_name(inamex,cnamex(inamex),cformx(inamex),'bzmx',idiag_bzmx)
call parse_name(inamex,cnamex(inamex),cformx(inamex),'bx2mx',idiag_bx2mx)
call parse_name(inamex,cnamex(inamex),cformx(inamex),'by2mx',idiag_by2mx)
call parse_name(inamex,cnamex(inamex),cformx(inamex),'bz2mx',idiag_bz2mx)
call parse_name(inamex,cnamex(inamex),cformx(inamex),'bxbymx',idiag_bxbymx)
call parse_name(inamex,cnamex(inamex),cformx(inamex),'bxbzmx',idiag_bxbzmx)
call parse_name(inamex,cnamex(inamex),cformx(inamex),'bybzmx',idiag_bybzmx)
call parse_name(inamex,cnamex(inamex),cformx(inamex),'betamx',idiag_betamx)
call parse_name(inamex,cnamex(inamex),cformx(inamex),'beta2mx',idiag_beta2mx)
call parse_name(inamex,cnamex(inamex),cformx(inamex),'jxbrxmx',idiag_jxbrxmx)
call parse_name(inamex,cnamex(inamex),cformx(inamex),'jxbrymx',idiag_jxbrymx)
call parse_name(inamex,cnamex(inamex),cformx(inamex),'jxbrzmx',idiag_jxbrzmx)
call parse_name(inamex,cnamex(inamex),cformx(inamex),'mflux_x',idiag_mflux_x)
call parse_name(inamex,cnamex(inamex),cformx(inamex),'etatotalmx',idiag_etatotalmx)
enddo
!
! Check for those quantities for which we want xz-averages.
!
do inamey=1,nnamey
call parse_name(inamey,cnamey(inamey),cformy(inamey),'bxmy',idiag_bxmy)
call parse_name(inamey,cnamey(inamey),cformy(inamey),'bymy',idiag_bymy)
call parse_name(inamey,cnamey(inamey),cformy(inamey),'bzmy',idiag_bzmy)
call parse_name(inamey,cnamey(inamey),cformy(inamey),'bx2my',idiag_bx2my)
call parse_name(inamey,cnamey(inamey),cformy(inamey),'by2my',idiag_by2my)
call parse_name(inamey,cnamey(inamey),cformy(inamey),'bz2my',idiag_bz2my)
call parse_name(inamey,cnamey(inamey),cformy(inamey),'bxbymy',idiag_bxbymy)
call parse_name(inamey,cnamey(inamey),cformy(inamey),'bxbzmy',idiag_bxbzmy)
call parse_name(inamey,cnamey(inamey),cformy(inamey),'bybzmy',idiag_bybzmy)
call parse_name(inamey,cnamey(inamey),cformy(inamey),'jxbrxmy',idiag_jxbrxmy)
call parse_name(inamey,cnamey(inamey),cformy(inamey),'jxbrymy',idiag_jxbrymy)
call parse_name(inamey,cnamey(inamey),cformy(inamey),'jxbrzmy',idiag_jxbrzmy)
call parse_name(inamey,cnamey(inamey),cformy(inamey),'mflux_y',idiag_mflux_y)
enddo
!
! Check for those quantities for which we want xy-averages.
!
do inamez=1,nnamez
call parse_name(inamez,cnamez(inamez),cformz(inamez),'axmz',idiag_axmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'aymz',idiag_aymz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'azmz',idiag_azmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'abuxmz',idiag_abuxmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'abuymz',idiag_abuymz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'abuzmz',idiag_abuzmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'uabxmz',idiag_uabxmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'uabymz',idiag_uabymz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'uabzmz',idiag_uabzmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bbxmz',idiag_bbxmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bbymz',idiag_bbymz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bbzmz',idiag_bbzmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bxmz',idiag_bxmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bymz',idiag_bymz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bzmz',idiag_bzmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'jxmz',idiag_jxmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'jymz',idiag_jymz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'jzmz',idiag_jzmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'Exmz',idiag_Exmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'Eymz',idiag_Eymz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'Ezmz',idiag_Ezmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bx2mz',idiag_bx2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'by2mz',idiag_by2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bz2mz',idiag_bz2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bx2rmz',idiag_bx2rmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'by2rmz',idiag_by2rmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bz2rmz',idiag_bz2rmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'beta1mz',idiag_beta1mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'betamz',idiag_betamz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'beta2mz',idiag_beta2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'ay2mz',idiag_ay2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'aybxmz',idiag_aybxmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bxbymz',idiag_bxbymz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bxbzmz',idiag_bxbzmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bybzmz',idiag_bybzmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'a2mz',idiag_a2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'b2mz',idiag_b2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bf2mz',idiag_bf2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'j2mz',idiag_j2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'poynzmz',idiag_poynzmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'jxbrxmz',idiag_jxbrxmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'jxbrymz',idiag_jxbrymz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'jxbrzmz',idiag_jxbrzmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'mflux_z',idiag_mflux_z)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'jbmz',idiag_jbmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bdel2amz',idiag_bdel2amz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'jdel2amz',idiag_jdel2amz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'d6abmz',idiag_d6abmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'d6amz1',idiag_d6amz1)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'d6amz2',idiag_d6amz2)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'d6amz3',idiag_d6amz3)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'abmz',idiag_abmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'ubmz',idiag_ubmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'ujmz',idiag_ujmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'obmz',idiag_obmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'uamz',idiag_uamz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bzuamz',idiag_bzuamz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bzaymz',idiag_bzaymz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bzdivamz',idiag_bzdivamz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bzLammz',idiag_bzLammz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'divamz',idiag_divamz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'uxbxmz',idiag_uxbxmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'uybxmz',idiag_uybxmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'uzbxmz',idiag_uzbxmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'uxbymz',idiag_uxbymz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'uybymz',idiag_uybymz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'uzbymz',idiag_uzbymz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'uxbzmz',idiag_uxbzmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'uybzmz',idiag_uybzmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'uzbzmz',idiag_uzbzmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'ujxbmz',idiag_ujxbmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'examz1',idiag_examz1)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'examz2',idiag_examz2)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'examz3',idiag_examz3)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'exatotalmz1',idiag_exatotalmz1)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'exatotalmz2',idiag_exatotalmz2)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'exatotalmz3',idiag_exatotalmz3)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'e3xamz1',idiag_e3xamz1)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'e3xamz2',idiag_e3xamz2)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'e3xamz3',idiag_e3xamz3)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'etatotalmz',idiag_etatotalmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'epsMmz',idiag_epsMmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'Rmmz',idiag_Rmmz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bxph1mz',idiag_bxph1mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bxph2mz',idiag_bxph2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bxph3mz',idiag_bxph3mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'byph1mz',idiag_byph1mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'byph2mz',idiag_byph2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'byph3mz',idiag_byph3mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bzph1mz',idiag_bzph1mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bzph2mz',idiag_bzph2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bzph3mz',idiag_bzph3mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bx2ph1mz',idiag_bx2ph1mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bx2ph2mz',idiag_bx2ph2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bx2ph3mz',idiag_bx2ph3mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'by2ph1mz',idiag_by2ph1mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'by2ph2mz',idiag_by2ph2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'by2ph3mz',idiag_by2ph3mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bz2ph1mz',idiag_bz2ph1mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bz2ph2mz',idiag_bz2ph2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bz2ph3mz',idiag_bz2ph3mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bx2rph1mz',idiag_bx2rph1mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bx2rph2mz',idiag_bx2rph2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bx2rph3mz',idiag_bx2rph3mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'by2rph1mz',idiag_by2rph1mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'by2rph2mz',idiag_by2rph2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'by2rph3mz',idiag_by2rph3mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bz2rph1mz',idiag_bz2rph1mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bz2rph2mz',idiag_bz2rph2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'bz2rph3mz',idiag_bz2rph3mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'abph1mz',idiag_abph1mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'abph2mz',idiag_abph2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'abph3mz',idiag_abph3mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'jbph1mz',idiag_jbph1mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'jbph2mz',idiag_jbph2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'jbph3mz',idiag_jbph3mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'poynzph1mz',idiag_poynzph1mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'poynzph2mz',idiag_poynzph2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'poynzph3mz',idiag_poynzph3mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'jxph1mz',idiag_jxph1mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'jyph1mz',idiag_jyph1mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'jzph1mz',idiag_jzph1mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'jxph2mz',idiag_jxph2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'jyph2mz',idiag_jyph2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'jzph2mz',idiag_jzph2mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'jxph3mz',idiag_jxph3mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'jyph3mz',idiag_jyph3mz)
call parse_name(inamez,cnamez(inamez),cformz(inamez),'jzph3mz',idiag_jzph3mz)
enddo
!
! Check for those quantities for which we want y-averages.
!
do ixz=1,nnamexz
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'b2mxz',idiag_b2mxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'axmxz',idiag_axmxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'aymxz',idiag_aymxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'azmxz',idiag_azmxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'bx1mxz',idiag_bx1mxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'by1mxz',idiag_by1mxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'bz1mxz',idiag_bz1mxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'bxmxz',idiag_bxmxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'bymxz',idiag_bymxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'bzmxz',idiag_bzmxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'jxmxz',idiag_jxmxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'jymxz',idiag_jymxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'jzmxz',idiag_jzmxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'bx2mxz',idiag_bx2mxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'by2mxz',idiag_by2mxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'bz2mxz',idiag_bz2mxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'bxbymxz',idiag_bxbymxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'bxbzmxz',idiag_bxbzmxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'bybzmxz',idiag_bybzmxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'uybxmxz',idiag_uybxmxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'uybzmxz',idiag_uybzmxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'Exmxz',idiag_Exmxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'Eymxz',idiag_Eymxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'Ezmxz',idiag_Ezmxz)
call parse_name(ixz,cnamexz(ixz),cformxz(ixz),'vAmxz',idiag_vAmxz)
enddo
!
! Check for those quantities for which we want z-averages.
!
do ixy=1,nnamexy
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'axmxy',idiag_axmxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'aymxy',idiag_aymxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'azmxy',idiag_azmxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'bxmxy',idiag_bxmxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'bymxy',idiag_bymxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'bzmxy',idiag_bzmxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'jxmxy',idiag_jxmxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'jymxy',idiag_jymxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'jzmxy',idiag_jzmxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'bx2mxy',idiag_bx2mxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'by2mxy',idiag_by2mxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'bz2mxy',idiag_bz2mxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'bxbymxy',idiag_bxbymxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'bxbzmxy',idiag_bxbzmxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'bybzmxy',idiag_bybzmxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'jbmxy',idiag_jbmxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'abmxy',idiag_abmxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'ubmxy',idiag_ubmxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'examxy1',idiag_examxy1)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'examxy2',idiag_examxy2)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'examxy3',idiag_examxy3)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'Exmxy',idiag_Exmxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'Eymxy',idiag_Eymxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'Ezmxy',idiag_Ezmxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'StokesImxy',idiag_StokesImxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'StokesQmxy',idiag_StokesQmxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'StokesUmxy',idiag_StokesUmxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'StokesQ1mxy',idiag_StokesQ1mxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'StokesU1mxy',idiag_StokesU1mxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'beta1mxy',idiag_beta1mxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'poynxmxy',idiag_poynxmxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'poynymxy',idiag_poynymxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'poynzmxy',idiag_poynzmxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'etatotalmxy',idiag_etatotalmxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'dbxdxmxy',idiag_dbxdxmxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'dbxdymxy',idiag_dbxdymxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'dbxdzmxy',idiag_dbxdzmxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'dbydxmxy',idiag_dbydxmxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'dbydymxy',idiag_dbydymxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'dbydzmxy',idiag_dbydzmxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'dbzdxmxy',idiag_dbzdxmxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'dbzdymxy',idiag_dbzdymxy)
call parse_name(ixy,cnamexy(ixy),cformxy(ixy),'dbzdzmxy',idiag_dbzdzmxy)
enddo
!
! Check for those quantities for which we want phi-averages.
!
do irz=1,nnamerz
call parse_name(irz,cnamerz(irz),cformrz(irz),'brmphi' ,idiag_brmphi)
call parse_name(irz,cnamerz(irz),cformrz(irz),'brsphmphi',idiag_brsphmphi)
call parse_name(irz,cnamerz(irz),cformrz(irz),'bthmphi',idiag_bthmphi)
call parse_name(irz,cnamerz(irz),cformrz(irz),'bpmphi' ,idiag_bpmphi)
call parse_name(irz,cnamerz(irz),cformrz(irz),'bzmphi' ,idiag_bzmphi)
call parse_name(irz,cnamerz(irz),cformrz(irz),'br2mphi' ,idiag_br2mphi)
call parse_name(irz,cnamerz(irz),cformrz(irz),'bp2mphi' ,idiag_bp2mphi)
call parse_name(irz,cnamerz(irz),cformrz(irz),'bz2mphi' ,idiag_bz2mphi)
call parse_name(irz,cnamerz(irz),cformrz(irz),'b2mphi' ,idiag_b2mphi)
call parse_name(irz,cnamerz(irz),cformrz(irz),'brbpmphi',idiag_brbpmphi)
call parse_name(irz,cnamerz(irz),cformrz(irz),'brbzmphi',idiag_brbzmphi)
call parse_name(irz,cnamerz(irz),cformrz(irz),'bpbzmphi',idiag_bpbzmphi)
call parse_name(irz,cnamerz(irz),cformrz(irz),'jbmphi' ,idiag_jbmphi)
call parse_name(irz,cnamerz(irz),cformrz(irz),'uxbrmphi',idiag_uxbrmphi)
call parse_name(irz,cnamerz(irz),cformrz(irz),'uxbpmphi',idiag_uxbpmphi)
call parse_name(irz,cnamerz(irz),cformrz(irz),'uxbzmphi',idiag_uxbzmphi)
call parse_name(irz,cnamerz(irz),cformrz(irz),'jxbrmphi',idiag_jxbrmphi)
call parse_name(irz,cnamerz(irz),cformrz(irz),'jxbpmphi',idiag_jxbpmphi)
call parse_name(irz,cnamerz(irz),cformrz(irz),'jxbzmphi',idiag_jxbzmphi)
call parse_name(irz,cnamerz(irz),cformrz(irz),'armphi' ,idiag_armphi)
call parse_name(irz,cnamerz(irz),cformrz(irz),'apmphi' ,idiag_apmphi)
call parse_name(irz,cnamerz(irz),cformrz(irz),'azmphi' ,idiag_azmphi)
!
enddo
!
! Check for those quantities for which we want phiz-averages.
!
do inamer=1,nnamer
call parse_name(inamer,cnamer(inamer),cformr(inamer),'brmr', idiag_brmr)
call parse_name(inamer,cnamer(inamer),cformr(inamer),'bpmr', idiag_bpmr)
call parse_name(inamer,cnamer(inamer),cformr(inamer),'bzmr', idiag_bzmr)
call parse_name(inamer,cnamer(inamer),cformr(inamer),'armr', idiag_armr)
call parse_name(inamer,cnamer(inamer),cformr(inamer),'apmr', idiag_apmr)
call parse_name(inamer,cnamer(inamer),cformr(inamer),'azmr', idiag_azmr)
call parse_name(inamer,cnamer(inamer),cformr(inamer),'b2mr', idiag_b2mr)
call parse_name(inamer,cnamer(inamer),cformr(inamer),'brbpmr',idiag_brbpmr)
enddo
!
! Check for those quantities for which we want to have in the sound.dat file.
!
do iname_sound=1,nname_sound
call parse_name(iname_sound,cname_sound(iname_sound),cform_sound(iname_sound),'bxpt',idiag_bxpt)
call parse_name(iname_sound,cname_sound(iname_sound),cform_sound(iname_sound),'bypt',idiag_bypt)
call parse_name(iname_sound,cname_sound(iname_sound),cform_sound(iname_sound),'bzpt',idiag_bzpt)
call parse_name(iname_sound,cname_sound(iname_sound),cform_sound(iname_sound),'bxbypt',idiag_bxbypt)
call parse_name(iname_sound,cname_sound(iname_sound),cform_sound(iname_sound),'bybzpt',idiag_bybzpt)
call parse_name(iname_sound,cname_sound(iname_sound),cform_sound(iname_sound),'bzbxpt',idiag_bzbxpt)
call parse_name(iname_sound,cname_sound(iname_sound),cform_sound(iname_sound),'axpt',idiag_axpt)
call parse_name(iname_sound,cname_sound(iname_sound),cform_sound(iname_sound),'aypt',idiag_aypt)
call parse_name(iname_sound,cname_sound(iname_sound),cform_sound(iname_sound),'azpt',idiag_azpt)
call parse_name(iname_sound,cname_sound(iname_sound),cform_sound(iname_sound),'jxpt',idiag_jxpt)
call parse_name(iname_sound,cname_sound(iname_sound),cform_sound(iname_sound),'jypt',idiag_jypt)
call parse_name(iname_sound,cname_sound(iname_sound),cform_sound(iname_sound),'jzpt',idiag_jzpt)
call parse_name(iname_sound,cname_sound(iname_sound),cform_sound(iname_sound),'Expt',idiag_Expt)
call parse_name(iname_sound,cname_sound(iname_sound),cform_sound(iname_sound),'Eypt',idiag_Eypt)
call parse_name(iname_sound,cname_sound(iname_sound),cform_sound(iname_sound),'Ezpt',idiag_Ezpt)
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),'aa',idum)
call parse_name(inamev,cnamev(inamev),cformv(inamev),'aps',ivid_aps)
call parse_name(inamev,cnamev(inamev),cformv(inamev),'bb',ivid_bb)
call parse_name(inamev,cnamev(inamev),cformv(inamev),'jj',ivid_jj)
call parse_name(inamev,cnamev(inamev),cformv(inamev),'b2',ivid_b2)
call parse_name(inamev,cnamev(inamev),cformv(inamev),'j2',ivid_j2)
call parse_name(inamev,cnamev(inamev),cformv(inamev),'bb_sph',ivid_bb_sph)
call parse_name(inamev,cnamev(inamev),cformv(inamev),'ab',ivid_ab)
call parse_name(inamev,cnamev(inamev),cformv(inamev),'jb',ivid_jb)
call parse_name(inamev,cnamev(inamev),cformv(inamev),'beta',ivid_beta1)
if (ivid_beta1/=0) then
call warning('rprint_magnetic',"'beta' slice was renamed to 'beta1'. "// &
achar(10)//"Update the label in your video.in.")
else
call parse_name(inamev,cnamev(inamev),cformv(inamev),'beta1',ivid_beta1)
endif
call parse_name(inamev,cnamev(inamev),cformv(inamev),'poynting',ivid_poynting)
enddo
!
! call corresponding mean-field routine
!
if (lmagn_mf) call rprint_magn_mf(lreset,lwrite)
!
endsubroutine rprint_magnetic
!***********************************************************************
subroutine dynamical_resistivity(uc)
!
! Dynamically set resistivity coefficient given fixed mesh Reynolds number.
!
! 27-jul-11/ccyang: coded
!
! Input Argument
! uc
! Characteristic velocity of the system.
!
real, intent(in) :: uc
!
! Hyper-resistivity coefficient
!
if (eta_hyper3 /= 0.0) eta_hyper3 = pi5_1 * uc * dxmax**5 / re_mesh
if (eta_hyper3_mesh /= 0.0) eta_hyper3_mesh = pi5_1 * uc / re_mesh / sqrt(real(dimensionality))
!
endsubroutine dynamical_resistivity
!***********************************************************************
subroutine split_update_magnetic(f)
!
! Update the magnetic potential by integrating the operator split
! magnetic terms.
!
! 23-aug-13/ccyang: coded
!
use ImplicitDiffusion, only: integrate_diffusion
!
real, dimension(mx,my,mz,mfarray), intent(inout) :: f
!
! Implicitly solve the resistive term.
!
if (limplicit_resistivity) call integrate_diffusion(get_resistivity_implicit,f,iax,iaz)
!
endsubroutine split_update_magnetic
!***********************************************************************
subroutine magnetic_after_timestep(f,df,dtsub)
!
use Mpicomm, only: mpibcast_real
use Sub, only: vecout_finalize, remove_mean
!
real, dimension(mx,my,mz,mfarray) :: f
real, dimension(mx,my,mz,mvar) :: df
real :: dtsub
!
if (lfargo_advection) then
if (lkeplerian_gauge) call keplerian_gauge(f)
if (lrmv.and.lremove_volume_average) call remove_mean(f,iax)
endif
!
if (lresi_vAspeed) then
if (lroot) then
if (fname(idiag_vArms)/=0.0) vArms=fname(idiag_vArms)
endif
call mpibcast_real(vArms)
endif
!
if (ldiagnos.and.bthresh_per_brms/=0) then
call vecout_finalize(41,trim(directory)//'/bvec',nbvec)
call calc_bthresh
endif
call keep_compiler_quiet(df)
call keep_compiler_quiet(dtsub)
!
endsubroutine magnetic_after_timestep
!****************************************************************************
subroutine magnetic_after_mn(df)
!
real, dimension(mx,my,mz,mvar) :: df
!
! Electron inertia: our df(:,:,:,iax:iaz) so far is
! (1 - l_e^2\Laplace) daa, thus to get the true daa, we need to invert
! that operator.
! [wd-aug-2007: This should be replaced by the more general stuff with the
! Poisson solver (so l_e can be non-constant), so at some point, we can
! remove/replace this]
!
! if (lelectron_inertia .and. inertial_length/=0.) then
! do iv = iax,iaz
! call inverse_laplacian_semispectral(df(:,:,:,iv), H=linertial_2)
! enddo
! df(:,:,:,iax:iaz) = -df(:,:,:,iax:iaz) * linertial_2
! endif
endsubroutine magnetic_after_mn
!****************************************************************************
subroutine braginsky
!
call not_implemented('braginsky','in magnetic')
endsubroutine braginsky
!***********************************************************************
subroutine keplerian_gauge(f)
!
use Boundcond, only: update_ghosts
use Deriv, only: der
use Mpicomm , only: mpiallreduce_sum
!
! Substract mean emf from the radial component of the induction
! equation. Activated only when large Bz fields and are present
! keplerian advection. Due to this u_phi x Bz term, the radial
! component of the magnetic potential
! develops a divergence that grows linearly in time. Since it is
! purely divergent, it is okay analytically. But numerically it leads to
! problems if this divergent grows bigger than the curl, which it does
! eventually.
!
! This is a cylindrical version of the rtime_phiavg special file.
!
! 13-sep-07/wlad: adapted from remove_mean_momenta
! 28-mar-17/MR: reinstated update_ghosts.
!
real, dimension (mx,my,mz,mfarray), intent (inout) :: f
real, dimension (mx,mz) :: fsum_tmp,glambda_rz,lambda
real, dimension (mz) :: glambda_z
integer :: i,l
!
!if (.not.lupdate_bounds_before_special) then
! print*,'The boundaries have not been updated prior '
! print*,'to calling this subroutine. This may lead '
! print*,'to troubles since it needs derivatives '
! print*,'and integrals, thus properly set ghost zones. '
! print*,'Use lupdate_bounds_before_special=T in '
! print*,'the run_pars of run.in.'
! call fatal_error("apply_keplerian_gauge","")
!endif
!
! Set ghost zones of iax.
!
call update_ghosts(f,iax)
!
! Average over phi - the result is a (mr=mx,mz) array
!
do n=1,mz
fsum_tmp(:,n) = (1./nygrid)*sum(f(:,m1:m2,n,iax),2)
enddo
!
! The sum has to be done processor-wise
! Sum over processors of same ipz, and different ipy
!
call mpiallreduce_sum(fsum_tmp,glambda_rz,(/mx,mz/),idir=2)
!
! Gauge-transform radial A
!
do m=m1,m2
f(l1:l2,m,n1:n2,iax) = f(l1:l2,m,n1:n2,iax) - glambda_rz(l1:l2,n1:n2)
enddo
!
! Integrate in R to get lambda, using N=6 composite Simpson's rule.
! Ghost zones in r needed for glambda_r.
!
do i=l1,l2
lambda(i,:) = dx/6.*( glambda_rz(i-3,:) +glambda_rz(i+3,:) + &
4*(glambda_rz(i-2,:)+glambda_rz(i,:)+glambda_rz(i+2,:))+ &
2*(glambda_rz(i-1,:) +glambda_rz(i+1,:)))
enddo
!
! Gauge-transform vertical A. Ghost zones in z needed for lambda.
!
do l=l1,l2
call der(3,lambda(l,:),glambda_z)
do m=m1,m2
f(l,m,n1:n2,iaz) = f(l,m,n1:n2,iaz) - glambda_z(n1:n2)
enddo
enddo
!
endsubroutine keplerian_gauge
!********************************************************************
subroutine remove_volume_average(f)
!
use Mpicomm , only: mpiallreduce_sum
!
! Substract mean emf from the radial component of the induction
! equation. Activated only when large Bz fields and are present
! keplerian advection. Due to this u_phi x Bz term, the radial
! component of the magnetic potential
! develops a divergence that grows linearly in time. Since it is
! purely divergent, it is okay analytically. But numerically it leads to
! problems if this divergent grows bigger than the curl, which it does
! eventually.
!
! This is a cylindrical version of the rtime_phiavg special file.
!MR: these comments seem not to apply, routine is now obsolete
! 13-sep-07/wlad: adapted from remove_mean_momenta
!
real, dimension (mx,my,mz,mfarray), intent (inout) :: f
real :: fsum_tmp,mean_ax
integer :: i
!
! Average over phi - the result is a (nr,nz) array
!
fsum_tmp = 0.
do m=m1,m2; do n=n1,n2 ; do i=l1,l2
fsum_tmp = fsum_tmp + f(i,m,n,iax)
enddo; enddo; enddo
fsum_tmp = fsum_tmp/nwgrid
!
! The sum has to be done processor-wise
! Sum over processors of same ipz, and different ipy
!
call mpiallreduce_sum(fsum_tmp,mean_ax)
!
! Gauge-transform radial A
!
f(l1:l2,m1:m2,n1:n2,iax) = f(l1:l2,m1:m2,n1:n2,iax) - mean_ax
!
endsubroutine remove_volume_average
!********************************************************************
subroutine get_resistivity_implicit(ndc, diffus_coeff, iz)
!
! Gets the diffusion coefficient along a given pencil for the implicit algorithm.
!
! 23-aug-13/ccyang: coded.
!
integer, intent(in) :: ndc
real, dimension(ndc), intent(out) :: diffus_coeff
integer, intent(in), optional :: iz
!
! Uniform resistivity
!
if (lresi_eta_const) then
diffus_coeff = eta
else
diffus_coeff = 0.0
endif
!
! z-dependent resistivity
!
if (lresi_zdep) then
if (present(iz)) then
diffus_coeff = diffus_coeff + eta_zgrid(iz)
else
diffus_coeff = diffus_coeff + eta_zgrid
endif
endif
!
endsubroutine get_resistivity_implicit
!***********************************************************************
subroutine expand_shands_magnetic
!
! Expands shorthand labels of magnetic 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,'brmphi','bpmphi','bzmphi',name='bbmphi')
if (name_is_present(cnamerz,'bpmphi')>0) then
call expand_cname(cnamerz,cformrz,nnamerz,'brsphmphi','bthmphi',name='bbsphmphi')
else
call expand_cname(cnamerz,cformrz,nnamerz,'brsphmphi','bthmphi','bpmphi',name='bbsphmphi')
endif
!
call expand_cname(cnamerz,cformrz,nnamerz,'uxbrmphi','uxbpmphi','uxbzmphi',name='uxbmphi')
call expand_cname(cnamerz,cformrz,nnamerz,'jxbrmphi','jxbpmphi','jxbzmphi',name='jxbmphi')
!
if (nnamerz>nnamerz_prev) then
if (.not.reallocate(fnamerz,nnamerz,4)) &
call fatal_error('expand_shands_magnetic','could not reallocate fnamerz')
endif
endif
!
endsubroutine expand_shands_magnetic
!***********************************************************************
subroutine get_bext(B_ext_out,J_ext_out)
!
! Get the external magnetic field at current time step.
!
! lbext_curvilinear = .true. is default. The B_ext the user defines in
! magnetic_init_pars respects the coordinate system of preference which
! means that B_ext=(0.0,1.0,0.0) is an azimuthal field in cylindrical
! coordinates and a polar one in spherical.
!
! 01-nov-14/ccyang: coded
!
use Sub, only: step, der_step
real, dimension(3), intent(out) :: B_ext_out
real, dimension(3), intent(out), optional :: J_ext_out
!
real :: c,s,zprof,zder,zpostop,zposbot
!
addBext: if (any(B_ext /= 0.0)) then
!
precess: if (omega_Bz_ext /= 0.0) then
!
! Allow external field to precess about z-axis with frequency omega_Bz_ext.
!
if (lcartesian_coords .or. lbext_curvilinear) then
c = cos(omega_Bz_ext * t)
s = sin(omega_Bz_ext * t)
B_ext_out(1) = B_ext(1) * c - B_ext(2) * s
B_ext_out(2) = B_ext(1) * s + B_ext(2) * c
B_ext_out(3) = B_ext(3)
else
call not_implemented('get_bext','precession of external field for curvilinear coordinates')
endif
elseif (lbext_moving_layer) then precess
!
! Add moving layer of uniform field
!
zposbot=zbot_moving_layer + t*speed_moving_layer
zpostop=ztop_moving_layer + t*speed_moving_layer
zprof = step(z(n), zposbot, edge_moving_layer)-step(z(n), zpostop, edge_moving_layer)
B_ext_out(1:2) = B_ext(1:2)*zprof; B_ext_out(3)=B_ext(3) ! z component not z dependent
if (present(J_ext_out)) then
zder = der_step(z(n),zposbot,edge_moving_layer)-der_step(z(n),zpostop,edge_moving_layer)
if (B_ext(1)/=0.) J_ext_out(2) = B_ext(1)*zder
if (B_ext(2)/=0.) J_ext_out(1) = -B_ext(2)*zder
endif
else precess
!
! Or add uniform background field.
!
if (lcartesian_coords .or. lbext_curvilinear) then
B_ext_out = B_ext
elseif (lcylindrical_coords) then
B_ext_out(1) = B_ext(1) * cos(y(m)) + B_ext(2) * sin(y(m))
B_ext_out(2) = -B_ext(1) * sin(y(m)) + B_ext(2) * cos(y(m))
B_ext_out(3) = B_ext(3)
elseif (lspherical_coords) then
B_ext_out(1) = B_ext(1) * sinth(m) * cos(z(n)) + B_ext(2) * sinth(m) * sin(z(n)) + B_ext(3) * costh(m)
B_ext_out(2) = B_ext(1) * costh(m) * cos(z(n)) + B_ext(2) * costh(m) * sin(z(n)) - B_ext(3) * sinth(m)
B_ext_out(3) = -B_ext(1) * sin(z(n)) + B_ext(2) * cos(z(n))
endif
if (present(J_ext_out)) J_ext_out=0.
endif precess
!
! Make the field gently increasing.
!
if (t_bext > 0.0 .and. t < t_bext) then
if (t <= t0_bext) then
B_ext_out = B0_ext
else
B_ext_out = B0_ext + 0.5*(1.-cos(pi*(t-t0_bext)/(t_bext-t0_bext)))*(B_ext_out-B0_ext)
endif
if (present(J_ext_out)) J_ext_out=0.
endif
else addBext
!
! Or no background field.
!
B_ext_out = 0.
if (present(J_ext_out)) J_ext_out=0.
!
endif addBext
!
endsubroutine get_bext
!***********************************************************************
real function get_B0_ext_z(pz)
!
! Get the external magnetic field stratification along z.
! vpandey: 2.July.2025
!
integer, intent(in) :: pz
!
get_B0_ext_z = Bz_stratified(pz)
!
endfunction get_B0_ext_z
!***********************************************************************
real function beltrami_phase()
use Mpicomm, only: mpibcast_real
real :: bcosphz, bsinphz
if (lroot) then
if (idiag_bcosphz/=0.and.idiag_bsinphz/=0) then
bcosphz=fname(idiag_bcosphz)
bsinphz=fname(idiag_bsinphz)
beltrami_phase=atan2(bsinphz,bcosphz)
else
call fatal_error('beltrami_phase','needs bcosphz, bsinphz in print.in')
endif
endif
call mpibcast_real(beltrami_phase)
endfunction beltrami_phase
!***********************************************************************
subroutine pushpars2c(p_par)
use Syscalls, only: copy_addr
use General , only: string_to_enum
integer, parameter :: n_pars=1000
integer(KIND=ikind8), dimension(n_pars) :: p_par
call copy_addr(eta,p_par(1))
call copy_addr(eta_hyper2,p_par(2))
call copy_addr(eta_hyper3,p_par(3))
call copy_addr(lresi_eta_const,p_par(4)) ! bool
call copy_addr(lresi_hyper2,p_par(5)) ! bool
call copy_addr(lresi_hyper3,p_par(6)) ! bool
call copy_addr(lupw_aa,p_par(7)) ! bool
call copy_addr(llorentzforce,p_par(8)) ! bool
call copy_addr(linduction,p_par(9)) ! bool
call copy_addr(iedotx,p_par(10)) ! int
call copy_addr(iedotz,p_par(11)) ! int
call copy_addr(b0_ext_z,p_par(12))
call copy_addr(b0_ext_z_h,p_par(13))
call copy_addr(t_bext,p_par(14))
call copy_addr(t0_bext,p_par(15))
call copy_addr(eta1_aniso,p_par(16))
call copy_addr(eta1_aniso_r,p_par(17))
call copy_addr(eta1_aniso_d,p_par(18))
call copy_addr(eta_shock,p_par(19))
call copy_addr(eta_shock2,p_par(20))
call copy_addr(alp_aniso,p_par(21))
call copy_addr(eta_aniso_bb,p_par(22))
call copy_addr(quench_aniso,p_par(23))
call copy_addr(eta_va,p_par(24))
call copy_addr(eta_j,p_par(25))
call copy_addr(eta_jrho,p_par(26))
call copy_addr(eta_min,p_par(27))
call copy_addr(eta_max,p_par(28))
call copy_addr(eta_huge,p_par(29))
call copy_addr(etaj20,p_par(30))
call copy_addr(va_min,p_par(31))
call copy_addr(varms,p_par(32))
call copy_addr(rhomin_jxb,p_par(33))
call copy_addr(va2max_jxb,p_par(34))
call copy_addr(va2max_boris,p_par(35))
call copy_addr(cmin,p_par(36))
call copy_addr(omega_bz_ext,p_par(37))
call copy_addr(inclaa,p_par(38))
call copy_addr(d_smag,p_par(39))
call copy_addr(b_ext2,p_par(40))
call copy_addr(nu_ni1,p_par(41))
call copy_addr(hall_term,p_par(42))
call copy_addr(battery_term,p_par(43))
call copy_addr(hall_tdep_t0,p_par(44))
call copy_addr(hall_tdep_exponent,p_par(45))
call copy_addr(hhall,p_par(46))
call copy_addr(hall_zdep_exponent,p_par(47))
call copy_addr(ampl_beltrami,p_par(48))
call copy_addr(eta_jump,p_par(49))
call copy_addr(eta_jump0,p_par(50))
call copy_addr(eta_jump1,p_par(51))
call copy_addr(etab,p_par(52))
call copy_addr(tau_relprof,p_par(53))
call copy_addr(tau_relprof1,p_par(54))
call copy_addr(dipole_moment,p_par(55))
call copy_addr(pm_smag1,p_par(56))
call copy_addr(va2power_jxb,p_par(58)) ! int
call copy_addr(iua,p_par(59)) ! int
call copy_addr(ilam,p_par(60)) ! int
call copy_addr(llorentz_rhoref,p_par(61)) ! bool
call copy_addr(ldiamagnetism,p_par(62)) ! bool
call copy_addr(lcovariant_magnetic,p_par(63)) ! bool
call copy_addr(ladd_global_field,p_par(64)) ! bool
call copy_addr(lresi_eta_tdep,p_par(65)) ! bool
call copy_addr(lresi_eta_xtdep,p_par(66)) ! bool
call copy_addr(lresi_eta_ztdep,p_par(67)) ! bool
call copy_addr(lresi_eta_tdep_t0_norm,p_par(68)) ! bool
call copy_addr(lresi_sqrtrhoeta_const,p_par(69)) ! bool
call copy_addr(lresi_eta_aniso,p_par(70)) ! bool
call copy_addr(lquench_eta_aniso,p_par(71)) ! bool
call copy_addr(lresi_etass,p_par(72)) ! bool
call copy_addr(lresi_hyper2_tdep,p_par(73)) ! bool
call copy_addr(lresi_hyper3_tdep,p_par(74)) ! bool
call copy_addr(lresi_hyper3_polar,p_par(75)) ! bool
call copy_addr(lresi_hyper3_mesh,p_par(76)) ! bool
call copy_addr(lresi_hyper3_csmesh,p_par(77)) ! bool
call copy_addr(lresi_hyper3_strict,p_par(78)) ! bool
call copy_addr(lresi_zdep,p_par(79)) ! bool
call copy_addr(lresi_ydep,p_par(80)) ! bool
call copy_addr(lresi_xdep,p_par(81)) ! bool
call copy_addr(lresi_rdep,p_par(82)) ! bool
call copy_addr(lresi_xydep,p_par(83)) ! bool
call copy_addr(lresi_hyper3_aniso,p_par(84)) ! bool
call copy_addr(lresi_eta_shock,p_par(85)) ! bool
call copy_addr(lresi_eta_shock2,p_par(86)) ! bool
call copy_addr(lresi_eta_shock_profz,p_par(87)) ! bool
call copy_addr(lresi_eta_shock_profr,p_par(88)) ! bool
call copy_addr(lresi_eta_shock_perp,p_par(89)) ! bool
call copy_addr(lresi_etava,p_par(90)) ! bool
call copy_addr(lresi_etaj,p_par(91)) ! bool
call copy_addr(lresi_etaj2,p_par(92)) ! bool
call copy_addr(lresi_etajrho,p_par(93)) ! bool
call copy_addr(lresi_shell,p_par(94)) ! bool
call copy_addr(lresi_smagorinsky,p_par(95)) ! bool
call copy_addr(lresi_smagorinsky_nusmag,p_par(96)) ! bool
call copy_addr(lresi_smagorinsky_cross,p_par(97)) ! bool
call copy_addr(lresi_anomalous,p_par(98)) ! bool
call copy_addr(lresi_spitzer,p_par(99)) ! bool
call copy_addr(lresi_cspeed,p_par(100)) ! bool
call copy_addr(lresi_vaspeed,p_par(101)) ! bool
call copy_addr(lalfven_as_aux,p_par(102)) ! bool
call copy_addr(lresi_magfield,p_par(103)) ! bool
call copy_addr(lresi_eta_proptouz,p_par(104)) ! bool
call copy_addr(lohmic_heat,p_par(105)) ! bool
call copy_addr(lneutralion_heat,p_par(106)) ! bool
call copy_addr(lj_ext,p_par(107)) ! bool
call copy_addr(lforcing_cont_aa_local,p_par(108)) ! bool
call copy_addr(lee_as_aux,p_par(109)) ! bool
call copy_addr(ladd_disp_current_from_aux,p_par(110)) ! bool
call copy_addr(lbb_as_aux,p_par(111)) ! bool
call copy_addr(ljj_as_aux,p_par(112)) ! bool
call copy_addr(ljxb_as_aux,p_par(113)) ! bool
call copy_addr(luxb_as_aux,p_par(114)) ! bool
call copy_addr(lugb_as_aux,p_par(115)) ! bool
call copy_addr(lbgu_as_aux,p_par(116)) ! bool
call copy_addr(lbdivu_as_aux,p_par(117)) ! bool
call copy_addr(lua_as_aux,p_par(118)) ! bool
call copy_addr(letasmag_as_aux,p_par(119)) ! bool
call copy_addr(ljj_as_comaux,p_par(120)) ! bool
call copy_addr(lbb_as_comaux,p_par(121)) ! bool
call copy_addr(lb_ext_in_comaux,p_par(122)) ! bool
call copy_addr(lbb_sph_as_aux,p_par(123)) ! bool
call copy_addr(lbext_curvilinear,p_par(124)) ! bool
call copy_addr(lcheck_positive_va2,p_par(125)) ! bool
call copy_addr(lsmooth_jj,p_par(126)) ! bool
call copy_addr(lambipolar_diffusion,p_par(127)) ! bool
call copy_addr(lcoulomb,p_par(128)) ! bool
call copy_addr(lvacuum,p_par(129)) ! bool
call copy_addr(loverride_ee,p_par(130)) ! bool
call copy_addr(loverride_ee2,p_par(131)) ! bool
call copy_addr(lignore_1rho_in_lorentz,p_par(132)) ! bool
call copy_addr(lohm_evolve,p_par(133)) ! bool
call copy_addr(eta_tdep_exponent,p_par(134))
call copy_addr(eta_tdep_t0,p_par(135))
call copy_addr(eta_tdep_toffset,p_par(136))
call copy_addr(eta_hyper3_mesh,p_par(137))
call copy_addr(eta_spitzer,p_par(138))
call copy_addr(eta_anom,p_par(139))
call copy_addr(eta_anom_thresh,p_par(140))
call copy_addr(eta_int,p_par(141))
call copy_addr(eta_ext,p_par(142))
call copy_addr(wresistivity,p_par(143))
call copy_addr(height_eta,p_par(144))
call copy_addr(eta_out,p_par(145))
call copy_addr(eta_cspeed,p_par(146))
call copy_addr(tau_aa_exterior,p_par(147))
call copy_addr(tauad,p_par(148))
call copy_addr(eta_zwidth,p_par(149))
call copy_addr(eta_rwidth,p_par(150))
call copy_addr(eta_width_shock,p_par(151))
call copy_addr(eta_zshock,p_par(152))
call copy_addr(eta_rwidth0,p_par(153))
call copy_addr(eta_rwidth1,p_par(154))
call copy_addr(eta_xshock,p_par(155))
call copy_addr(eta_r0,p_par(156))
call copy_addr(eta_r1,p_par(157))
call copy_addr(alphassm,p_par(158))
call copy_addr(j_ext_quench,p_par(159))
call copy_addr(b2_diamag,p_par(160))
call copy_addr(ampl_ff,p_par(162))
call copy_addr(swirl,p_par(163))
call copy_addr(ampl_fcont_aa,p_par(164))
call copy_addr(llambda_aa,p_par(165))
call copy_addr(vcrit_anom,p_par(166))
call copy_addr(numag,p_par(167))
call copy_addr(b0_magfric,p_par(168))
call copy_addr(ekman_friction_aa,p_par(169))
call copy_addr(exp_epspb,p_par(170))
call copy_addr(ncr_quench,p_par(171))
call copy_addr(ampl_eta_uz,p_par(172))
call copy_addr(no_ohmic_heat_z0,p_par(173))
call copy_addr(no_ohmic_heat_zwidth,p_par(174))
call copy_addr(imp_alpha0,p_par(175))
call copy_addr(imp_halpha,p_par(176))
call copy_addr(c_light21,p_par(177))
call copy_addr(betamin_jxb,p_par(178))
call copy_addr(lweyl_gauge,p_par(179)) ! bool
call copy_addr(ladvective_gauge,p_par(180)) ! bool
call copy_addr(ladvective_gauge2,p_par(181)) ! bool
call copy_addr(lforcing_cont_aa,p_par(182)) ! bool
call copy_addr(iforcing_cont_aa,p_par(183)) ! int
call copy_addr(lkinematic,p_par(184)) ! bool
call copy_addr(lignore_bext_in_b2,p_par(185)) ! bool
call copy_addr(luse_bext_in_b2,p_par(186)) ! bool
call copy_addr(lmean_friction,p_par(187)) ! bool
call copy_addr(llocal_friction,p_par(188)) ! bool
call copy_addr(lambipolar_strong_coupling,p_par(189)) ! bool
call copy_addr(lhalox,p_par(190)) ! bool
call copy_addr(lno_ohmic_heat_bound_z,p_par(191)) ! bool
call copy_addr(lmagneto_friction,p_par(192)) ! bool
call copy_addr(limplicit_resistivity,p_par(193)) ! bool
call copy_addr(lncr_correlated,p_par(194)) ! bool
call copy_addr(lncr_anticorrelated,p_par(195)) ! bool
call copy_addr(ladd_efield,p_par(196)) ! bool
call copy_addr(lsld_bb,p_par(197)) ! bool
call copy_addr(la_relprof_global,p_par(198)) ! bool
call copy_addr(lmagnetic_slope_limited,p_par(199)) ! bool
call copy_addr(lboris_correction,p_par(200)) ! bool
call copy_addr(lnoinduction,p_par(201)) ! bool
!call copy_addr(lrhs_max,p_par(202)) ! bool
call copy_addr(limp_alpha,p_par(203)) ! bool
call copy_addr(fac_sld_magn,p_par(204))
call copy_addr(ampl_efield,p_par(205))
call copy_addr(rhoref,p_par(206))
call copy_addr(rhoref1,p_par(207))
call copy_addr(ell_jj,p_par(208))
call copy_addr(tau_jj,p_par(209))
call copy_addr(lbext_moving_layer,p_par(210)) ! bool
call copy_addr(lno_eta_tdep,p_par(211)) ! bool
call copy_addr(zbot_moving_layer,p_par(212))
call copy_addr(ztop_moving_layer,p_par(213))
call copy_addr(speed_moving_layer,p_par(214))
call copy_addr(edge_moving_layer,p_par(215))
call copy_addr(idiag_udotxbm,p_par(216)) ! int
call copy_addr(idiag_uxbdotm,p_par(217)) ! int
call copy_addr(eta_shock_jump1,p_par(218))
call copy_addr(r2,p_par(220))
call copy_addr(r12,p_par(221))
call copy_addr(b_ext,p_par(223)) ! real3
call copy_addr(b0_ext,p_par(224)) ! real3
call copy_addr(b1_ext,p_par(225)) ! real3
call copy_addr(j_ext,p_par(226)) ! real3
call copy_addr(eta_aniso_hyper3,p_par(227)) ! real3
call copy_addr(lfrozen_bb_bot,p_par(228)) ! bool3
call copy_addr(lfrozen_bb_top,p_par(229)) ! bool3
call copy_addr(eta_xy,p_par(230)) ! (mx) (my)
call copy_addr(geta_xy,p_par(231)) ! (mx) (my) (3)
call copy_addr(a_relprof,p_par(232)) ! (nz) (3)
call copy_addr(eta_z,p_par(233)) ! (mz)
call copy_addr(geta_z,p_par(234)) ! (mz)
call copy_addr(eta_x,p_par(235)) ! (mx)
call copy_addr(geta_x,p_par(236)) ! (mx)
call copy_addr(eta_y,p_par(237)) ! (my)
call copy_addr(geta_y,p_par(238)) ! (my)
call copy_addr(feta_ztdep,p_par(239)) ! (mz)
call copy_addr(phix,p_par(240)) ! (mx)
call copy_addr(sinx,p_par(241)) ! (mx)
call copy_addr(cosx,p_par(242)) ! (mx)
call copy_addr(phiy,p_par(243)) ! (my)
call copy_addr(siny,p_par(244)) ! (my)
call copy_addr(cosy,p_par(245)) ! (my)
call copy_addr(phiz,p_par(246)) ! (mz)
call copy_addr(sinz,p_par(247)) ! (mz)
call copy_addr(cosz,p_par(248)) ! (mz)
call string_to_enum(enum_tdep_eta_type,tdep_eta_type)
call copy_addr(enum_tdep_eta_type,p_par(250)) ! int
call string_to_enum(enum_ambipolar_diffusion,ambipolar_diffusion)
call copy_addr(enum_ambipolar_diffusion,p_par(251)) ! int
call string_to_enum(enum_rdep_profile,rdep_profile)
call copy_addr(enum_rdep_profile,p_par(252)) ! int
call string_to_enum(enum_ihall_term,ihall_term)
call copy_addr(enum_ihall_term,p_par(253)) ! int
call string_to_enum(enum_iforcing_continuous_aa,iforcing_continuous_aa)
call copy_addr(enum_iforcing_continuous_aa,p_par(254)) ! int
call string_to_enum(enum_borderaa(1),borderaa(1))
call string_to_enum(enum_borderaa(2),borderaa(2))
call string_to_enum(enum_borderaa(3),borderaa(3))
call copy_addr(enum_borderaa,p_par(255)) ! int3
call copy_addr(bz_stratified,p_par(256)) ! (mz)
call copy_addr(amp_relprof,p_par(258))
call copy_addr(lhubble_magnetic,p_par(259)) ! bool
call copy_addr(learly_set_el_pencil,p_par(260)) ! bool
!TP: needed for transpilation but name collides with hydro so will not work without
! module qualified name, so to not break handwritten DSL code have it on comment
!call copy_addr(lrhs_max,p_par(261)) ! bool
!call copy_addr(gamma1,p_par(262))
call copy_addr(k1_ff_mag,p_par(161))
call copy_addr(lrelaxprof_glob_scaled,p_par(263)) ! bool
call copy_addr(scl_uxb_in_ohm,p_par(264))
call copy_addr(w_sldchar_mag,p_par(265))
call copy_addr(h_sld_magn,p_par(266))
call copy_addr(nlf_sld_magn,p_par(267))
endsubroutine pushpars2c
!***********************************************************************
endmodule Magnetic