! $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 use Magnetic_meanfield, pushpars2c_mf => pushpars2c use Messages, only: fatal_error,inevitably_fatal_error,warning,svn_id,timing,not_implemented,information ! 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 ! ! Parameters ! integer, parameter :: nresi_max=4 ! real, dimension (ninit) :: amplaa=0.0 !PAR_DOC: amplitude for some types of !PAR_DOC: initial magnetic fields. real, dimension (ninit) :: amplaa2=0.0 !PAR_DOC: amplitude for some types of !PAR_DOC: magnetic field perturbation real, dimension (ninit) :: 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 integer :: icurlb=0, icurlbx=0, icurlby=0, icurlbz=0 integer :: iacou=0, iacoux=0, iacouy=0, iacouz=0 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. real, dimension(3) :: widthaa=0.5 !PAR_DOC: used by some initial fields 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_yaver_range=(/-max_real,max_real/) real, dimension(2) :: magnetic_zaver_range=(/-max_real,max_real/) real, dimension(nx) :: xmask_mag, xmask1_mag real, dimension(ny) :: ymask_mag real, dimension(nz) :: zmask_mag real, dimension(3,3) :: bij_0D_test=0. 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 !PAR_DOC: used by some initial fields real :: epsilonaa=0.01 !PAR_DOC: used by some initial fields real :: x0aa=0.0, y0aa=0.0 real :: z0aa=0.0 !PAR_DOC: used by some initial fields 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. real :: r_dip=1 , epsi_dip=0.1, angle_dip=0., je_heating_factor=1. integer, target :: va2power_jxb = 5 integer :: nbvec, nbvecmax=nx*ny*nz/4, iua=0, iLam=0, idiva=0 integer :: N_modes_aa=1, naareset integer :: ibij=0 logical, pointer :: lrelativistic_eos, lconservative, lrho_chi logical :: lpress_equil=.false. !PAR_DOC: flag for pressure equilibrium (can !PAR_DOC: be used in connection with all initial fields) logical :: 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., lcurlb_as_aux=.false. logical :: luxb_as_aux=.false., lugb_as_aux=.false., lbgu_as_aux=.false. logical :: lbdivu_as_aux=.false., lbij_as_aux=.false., lbij_test=.false. logical :: lbbt_as_aux=.false., ljjt_as_aux=.false., lua_as_aux=.false. logical :: ljbt_as_aux=.false., lj2t_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 :: laa_cou_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=.true. logical :: lfactors_aa=.false., lvacuum=.false., ldensity_add_je_heating=.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, & laa_cou_as_aux, lcurlb_as_aux, lbij_as_aux, lbij_test, & luxb_as_aux, lugb_as_aux, lbgu_as_aux, lbeta_as_aux, lbdivu_as_aux, & lua_as_aux, ljbt_as_aux, lj2t_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_yaver_range, magnetic_zaver_range, & lbx_ext_global,lby_ext_global,lbz_ext_global, dipole_moment, & lax_ext_global,lay_ext_global,laz_ext_global, bij_0D_test, & 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, ldensity_add_je_heating, l2d_aa, & loverride_ee_decide, eta_tdep_loverride_ee, z0_gaussian, width_gaussian, & lnorm_aa_kk, lohm_evolve, lhubble_magnetic,r_dip, epsi_dip, angle_dip ! ! 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. logical :: luse_bgb_as_jxb=.false. !PAR_DOC: replace JxB by B.gradB in auxiliary array, for test purposes. logical :: lreset_vart_only_at_start=.false. !PAR_DOC: reset vart only at start 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, & laa_cou_as_aux, lbij_as_aux, lbij_test, luxb_as_aux, lugb_as_aux, lbgu_as_aux, lbdivu_as_aux, & lkinematic, lbbt_as_aux, ljjt_as_aux, lua_as_aux, ljbt_as_aux, lj2t_as_aux, ljxb_as_aux, lcurlb_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_yaver_range, 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, bij_0D_test, & 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, & ldensity_add_je_heating, je_heating_factor, & 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, & luse_bgb_as_jxb, lno_eta_tdep, luse_scale_factor_in_sigma, ell_jj, tau_jj, lhubble_magnetic, & scl_uxb_in_ohm, eta_tdep_ascale_power,r_dip, epsi_dip, angle_dip, lreset_vart_only_at_start ! ! 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: $\log_{10}\left<\Bv^4\right>$ integer :: idiag_b6m=0 ! DIAG_DOC: $\log_{10}\left<\Bv^6\right>$ integer :: idiag_b8m=0 ! DIAG_DOC: $\log_{10}\left<\Bv^8\right>$ integer :: idiag_b12m=0 ! DIAG_DOC: $\log_{10}\left<\Bv^{12}\right>$ integer :: idiag_logbm=0 ! DIAG_DOC: $\left<\log B\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_acbm=0 ! DIAG_DOC: $\left<\Av_\mathrm{Cou}\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$ integer :: idiag_abumy=0 ! DIAG_DOC: $\left$ integer :: idiag_abumz=0 ! DIAG_DOC: $\left$ 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$ integer :: idiag_uybxm=0 ! DIAG_DOC: $\left$ integer :: idiag_uzbxm=0 ! DIAG_DOC: $\left$ integer :: idiag_uxbym=0 ! DIAG_DOC: $\left$ integer :: idiag_uybym=0 ! DIAG_DOC: $\left$ integer :: idiag_uzbym=0 ! DIAG_DOC: $\left$ integer :: idiag_uxbzm=0 ! DIAG_DOC: $\left$ integer :: idiag_uybzm=0 ! DIAG_DOC: $\left$ integer :: idiag_uzbzm=0 ! DIAG_DOC: $\left$ integer :: idiag_uxjxm=0 ! DIAG_DOC: $\left$ integer :: idiag_uxjym=0 ! DIAG_DOC: $\left$ integer :: idiag_uxjzm=0 ! DIAG_DOC: $\left$ integer :: idiag_uyjxm=0 ! DIAG_DOC: $\left$ integer :: idiag_uyjym=0 ! DIAG_DOC: $\left$ integer :: idiag_uyjzm=0 ! DIAG_DOC: $\left$ integer :: idiag_uzjxm=0 ! DIAG_DOC: $\left$ integer :: idiag_uzjym=0 ! DIAG_DOC: $\left$ integer :: idiag_uzjzm=0 ! DIAG_DOC: $\left$ integer :: idiag_cosubm=0 ! DIAG_DOC: $\left<\Uv\cdot\Bv/(|\Uv|\,|\Bv|) ! DIAG_DOC: \right>$ integer :: idiag_jxbxm=0 ! DIAG_DOC: $\left$ integer :: idiag_jybxm=0 ! DIAG_DOC: $\left$ integer :: idiag_jzbxm=0 ! DIAG_DOC: $\left$ integer :: idiag_jxbym=0 ! DIAG_DOC: $\left$ integer :: idiag_jybym=0 ! DIAG_DOC: $\left$ integer :: idiag_jzbym=0 ! DIAG_DOC: $\left$ integer :: idiag_jxbzm=0 ! DIAG_DOC: $\left$ integer :: idiag_jybzm=0 ! DIAG_DOC: $\left$ integer :: idiag_jzbzm=0 ! DIAG_DOC: $\left$ 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$ 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_az2m=0 ! DIAG_DOC: $\left$ 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$ integer :: idiag_bym=0 ! DIAG_DOC: $\left$ integer :: idiag_bzm=0 ! DIAG_DOC: $\left$ integer :: idiag_jxm=0 ! DIAG_DOC: $\left$ integer :: idiag_jym=0 ! DIAG_DOC: $\left$ integer :: idiag_jzm=0 ! DIAG_DOC: $\left$ integer :: idiag_bxbym=0 ! DIAG_DOC: $\left$ integer :: idiag_bxbzm=0 ! DIAG_DOC: $\left$ integer :: idiag_bybzm=0 ! DIAG_DOC: $\left$ 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$ integer :: idiag_b3b12m=0 ! DIAG_DOC: $\left$ integer :: idiag_b1b32m=0 ! DIAG_DOC: $\left$ integer :: idiag_b1b23m=0 ! DIAG_DOC: $\left$ integer :: idiag_b2b13m=0 ! DIAG_DOC: $\left$ integer :: idiag_b2b31m=0 ! DIAG_DOC: $\left$ 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$ integer :: idiag_WL3D=0 ! DIAG_DOC: $-\left$ integer :: idiag_WL3D2=0 ! DIAG_DOC: $\left$ integer :: idiag_gb2m=0 ! DIAG_DOC: $\left<|\hat{B}_{i,j}|^2\right>$ integer :: idiag_bij2m=0 ! DIAG_DOC: $\left<|\hat{B}_{i,j}|^2\right>$ integer :: idiag_sijbibjm=0 ! DIAG_DOC: $\left$ 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_z(x,y)]^2 + ! DIAG_DOC: [\left_z(x,y)]^2 + ! DIAG_DOC: [\left_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_\varphi$ ! PHIAVG_DOC: [cyl.\ polar coords ! PHIAVG_DOC: $(\varpi,\varphi,z)$] integer :: idiag_bpmphi=0 ! PHIAVG_DOC: $\left_\varphi$ integer :: idiag_bzmphi=0 ! PHIAVG_DOC: $\left_\varphi$ integer :: idiag_br2mphi=0 ! PHIAVG_DOC: $\left_\varphi$ integer :: idiag_bp2mphi=0 ! PHIAVG_DOC: $\left_\varphi$ integer :: idiag_bz2mphi=0 ! PHIAVG_DOC: $\left_\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_\varphi$ integer :: idiag_bthmphi=0 ! PHIAVG_DOC: $\left_\varphi$ integer :: idiag_brsmphi=0 ! PHIAVG_DOC: $\left<\sin\theta B_\varpi\right>_\varphi$ integer :: idiag_brcmphi=0 ! PHIAVG_DOC: $\left<\cos\theta B_\varpi\right>_\varphi$ integer :: idiag_bpsmphi=0 ! PHIAVG_DOC: $\left<\sin\theta B_\varphi\right>_\varphi$ integer :: idiag_bpcmphi=0 ! PHIAVG_DOC: $\left<\cos\theta B_\varphi\right>_\varphi$ integer :: idiag_bzsmphi=0 ! PHIAVG_DOC: $\left<\sin\theta B_z\right>_\varphi$ integer :: idiag_bzcmphi=0 ! PHIAVG_DOC: $\left<\cos\theta B_z\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_\varphi$ integer :: idiag_brbzmphi=0 ! PHIAVG_DOC: $\left_\varphi$ integer :: idiag_bpbzmphi=0 ! PHIAVG_DOC: $\left_\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|_{xy}$ integer :: idiag_bzaymz=0 ! XYAVG_DOC: $\left|_{xy}$ integer :: idiag_bzdivamz=0 ! XYAVG_DOC: $\left|_{xy}$ integer :: idiag_bzLammz=0 ! XYAVG_DOC: $\left|_{xy}$ integer :: idiag_divamz=0 ! XYAVG_DOC: $\left<\nabla\cdot\Av\right>|_{xy}$ integer :: idiag_uxbxmz=0 ! XYAVG_DOC: $\left|_{xy}$ integer :: idiag_uybxmz=0 ! XYAVG_DOC: $\left|_{xy}$ integer :: idiag_uzbxmz=0 ! XYAVG_DOC: $\left|_{xy}$ integer :: idiag_uxbymz=0 ! XYAVG_DOC: $\left|_{xy}$ integer :: idiag_uybymz=0 ! XYAVG_DOC: $\left|_{xy}$ integer :: idiag_uzbymz=0 ! XYAVG_DOC: $\left|_{xy}$ integer :: idiag_uxbzmz=0 ! XYAVG_DOC: $\left|_{xy}$ integer :: idiag_uybzmz=0 ! XYAVG_DOC: $\left|_{xy}$ integer :: idiag_uzbzmz=0 ! XYAVG_DOC: $\left|_{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_bcurlfmz=0 ! XYAVG_DOC: $\left< \Bv \cdot \nabla\times \vec{F}/\mu_0\right>_{xy}$, where $\vec{F}$ is the additional EMF imposed through continuous forcing (lforcing_cont_aa=T) 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_j2mx = 0 ! YZAVG_DOC: $\langle J^2\rangle_{yz}$ integer :: idiag_jbmx = 0 ! YZAVG_DOC: $\langle \Jv\cdot\Bv\rangle_{yz}$ integer :: idiag_b2mmx = 0 ! YZAVG_DOC: $\langle B^2\rangle_{yz,\mathrm{mask}}$ 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_{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_{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_{z}|_z$ integer :: idiag_StokesU1mxy=0! ZAVG_DOC: $-\left_{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,diffus_eta) 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 !$omp threadprivate(eta_tdep,eta_xtdep) 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 (lbij_as_aux) call farray_register_auxiliary('bij', ibij, vector=9) ! 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 (ljbt_as_aux) then call register_report_aux('jbt',ijbt) ltime_integrals=.true. endif ! if (lj2t_as_aux) then call register_report_aux('j2t',ij2t) 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 (laa_cou_as_aux) then if (lcoulomb) then !call register_report_aux('acou',iacou,iacoux,iacouy,iacouz) call farray_register_auxiliary('acou',iacou,vector=3) iacoux=iacou; iacouy=iacou+1; iacouz=iacou+2 else call fatal_error('register_magnetic','lcoulomb must be true for laa_cou_as_aux=T') endif endif ! ! Need to check whether the underlying pencils need to be computed every time, ! or only when ldiagnos. If anything like this, it should probably rather be ! when an output file is written, i.e., when lsnap=T. ! 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 (lcurlb_as_aux) call register_report_aux('curlb',icurlb,icurlbx,icurlby,icurlbz) 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.,rhs=.true.) 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) ! if (lspecial) then call put_shared_variable('B0_ext_z', B0_ext_z) call put_shared_variable('Bz_stratified', Bz_stratified) endif 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 ! 24-mar-26/axel: corrected mask1 so that it works even if only one point is valid. ! use Sub, only: register_report_aux, write_zprof, step, get_smooth_kernel !, coeff_ydep 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)) !AB: corrected mask so that it works even if only one point is valid. where ( x(l1:l2) > magnetic_xaver_range(1) & .and. x(l1:l2) < magnetic_xaver_range(2)) xmask_mag = 1. xmask1_mag = 1. elsewhere xmask_mag = 0. xmask1_mag = max_real xmask1_mag = 0. endwhere 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 y- or yz-averaging where y is in magnetic_yaver_range. ! Normalize such that the average over the full domain gives still unity. ! In other words, if range1+range2=fullrange, then ! aver(fullrange) = p*aver(range1) + q*aver(range2), ! where p=range1/fullrange and q=1-p. ! if (m1 == m2) then ymask_mag = 1. else where (y(m1:m2) >= magnetic_yaver_range(1) .and. y(m1:m2) <= magnetic_yaver_range(2)) ymask_mag = 1. elsewhere ymask_mag = 0. endwhere magnetic_yaver_range(1) = max(magnetic_yaver_range(1), xyz0(2)) magnetic_yaver_range(2) = min(magnetic_yaver_range(2), xyz1(2)) ymask_mag = ymask_mag*Lxyz(2)/(magnetic_yaver_range(2) - magnetic_yaver_range(1)) endif ! ! Compute mask for z-averaging where z is in magnetic_zaver_range. ! Normalize the same way as for ymask_mag. ! 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=',iproc,xmask_mag print*,'ymask_mag=',iproc,ymask_mag print*,'zmask_mag=',iproc,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 ('remove_xyaver_from_Ax'); f(l1:l2,m1:m2,n1:n2,iax)=f(l1:l2,m1:m2,n1:n2,iax)- & spread(spread(sum(sum(f(l1:l2,m1:m2,n1:n2,iax),dim=2)/ny,dim=1)/nx,1,nx),2,ny) 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 coeff_ydep(ydep_profile, y, eta, eta_ampl, eta_y, geta_y, eta_jump, eta_ywidth, eta_y0, eta_y1, two_step_factor) 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. .and. B0_ext_z /= 0.) then Bz_stratified = B0_ext_z * exp(-z/B0_ext_z_H) else Bz_stratified = 0. endif endsubroutine initialize_magnetic !*********************************************************************** 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 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 (nz) :: 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 ('sech2x'); call sech2x(amplaa(j),f,iaa,sheet_thickness) 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)) !15-10-25/axel: replaced input parameters, e.g., z1_aa=-.5, z2_aa=.5, widthaa=.1 tmp=amplaa(1)*.5*(tanh((z(n1:n2)-z1_aa)/widthaa(1))-tanh((z(n1:n2)-z2_aa)/widthaa(1))) call gaunoise(tmp,f,iax,iaz) case ('gaussian-noise-zprof2') call fatal_error("init_aa","use gaussian-noise-zprof with z1_aa, z2_aa, and widthaa") !tmp=amplaa(1)*.5*(tanh((z(n1:n2)-znoise_int)/0.05)-tanh((z(n1:n2)-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 ('quadrupole'); call quadrupole(f,iax,amplaa(j),r_inner,r_outer) case ('quadrupole2'); call quadrupole2(f,iax,amplaa(j),r_inner,r_outer) case ('quadrupole3'); call quadrupole3(f,iax,amplaa(j),r_inner,r_outer) case ('dipoleA'); call dipoleA(f,iax,amplaa(j),r_dip,angle_dip) case ('dipoleB'); call dipoleB(f,iax,amplaa(j),epsi_dip,angle_dip) 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 ! ! dipolar test case ! case ('dipolar-test-case') do n=n1,n2; do m=m1,m2 f(l1:l2,m,n,iax) = 0!amplaa(j)/x(l1:l2)**2*sin(y(m))**2*(-1.5) !*(1.-relhel_aa) f(l1:l2,m,n,iay) = amplaa(j)/x(l1:l2)**2*sin(y(m))*cos(y(m))*(-3.)*relhel_aa f(l1:l2,m,n,iaz) = 0!amplaa(j)/x(l1:l2)**2*sin(y(m)) enddo; enddo ! ! quadrupolar test case ! case ('quadrupolar-test-case') 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)**2*3*sin(y(m))*cos(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 (ldisp_current) 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 (ljbt_as_aux) lpenc_requested(i_jb)=.true. ! if (lj2t_as_aux) then lpenc_requested(i_j2)=.true. lpenc_requested(i_ujxb)=.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 (laa_cou_as_aux .or. lcoulomb_apply) then if (lcoulomb) then lpenc_requested(i_gLam)=.true. else call fatal_error('pencil_criteria_magnetic', 'Set lcoulomb=T, etc') endif 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 ! if (ldensity .and. ldensity_add_je_heating .and. ldisp_current) then lpenc_requested(i_jj)=.true. lpenc_requested(i_el)=.true. lpenc_requested(i_rho1)=.true. 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_brsmphi/=0 .or. idiag_brcmphi/=0 .or. idiag_bpsmphi/=0 & .or. idiag_bpcmphi/=0 .or. idiag_bzsmphi/=0 .or. idiag_bzcmphi/=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_gb2m/=0) lpenc_diagnos(i_bij)=.true. 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_b8m/=0 .or. idiag_b12m/=0 .or.& idiag_logbm/=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_b2mmx/=0 .or. idiag_b2mz/=0 .or. & idiag_a2b2m/=0 .or. idiag_j2b2m/=0) & lpenc_diagnos(i_b2)=.true. if (idiag_j2mx/=0) lpenc_diagnos(i_j2)=.true. if (idiag_jbmx/=0) lpenc_diagnos(i_jb)=.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. if (idiag_bcurlfmz/=0) lpenc_diagnos(i_curlfcont)=.true. ! ! For Coulomb gauge. The diagnostics results depend on whether or ! not also laa_cou_as_aux or lcoulomb_apply are true. ! Those results may still be correct, but for another time step. ! if (idiag_gLamam/=0 .or. idiag_gLambm/=0) then if (lcoulomb) then lpenc_diagnos(i_gLam)=.true. else call fatal_error('pencil_criteria_magnetic', 'Set lcoulomb=T, etc') endif endif ! ! 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_ujxb)) then lpencil_in(i_jxb)=.true. lpencil_in(i_uu)=.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 ! ! Compute B.gradB, when used as JxB in kinematic flow routine, for example. ! if (luse_bgb_as_jxb) lpencil_in(i_bgb)=.true. ! !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_gLam)) lpencil_in(i_diva)=.true. ! ! 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) ! ! The default for learly_set_el_pencil is now changed to .true., but ! it is now changed to .false. if there is no displacement current. ! if (.not. ldisp_current) learly_set_el_pencil=.false. ! 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 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. ! 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 or correct 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) ! ! Compute Alfven speed. Take scale factor (=1 by default) into account. ! tmp=ascale*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) tmp=tmp/sqrt(1.+(tmp/va2max_boris)**2.) f(l1:l2,m,n,isld_char)=f(l1:l2,m,n,isld_char)+w_sldchar_mag*sqrt(tmp) endif endif enddo ! mn_loop endif ! if (lbb_as_comaux ... ! ! 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 ! _C = _W - gLambm, and _C = _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) !$omp parallel num_threads(1) call inverse_laplacian(rhs_poisson) !$omp end parallel 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 !*********************************************************************** !NOT USED SO ON COMMENT ! 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 get_eta_t_and_xtdep(f,p) ! ! 27-oct-2025/TP: carved from daa_dt ! use SharedVariables, only: get_shared_variable real, dimension(mx,my,mz,mfarray), intent(in) :: f type(pencil_case), intent(in) :: p real, dimension (nx) :: Eabs, Babs real :: Eaver, Baver !, b2m 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 (Eaver0) 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('get_eta_t_and_xtdep','electric field must be computed') endif Babs=sqrt(p%b2) ! ! Note that for Babs=0, eta_xtdep=0 ! where (Eabs0. ! use EquationOfState, only: rho0 use General, only: notanumber 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(3) :: B_ext, j_ext real :: c,s 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. ! 2026-Feb-20/Kishore: removed the pencil-check workaround as per my comment ! below on i_bb if (lpenc_loc(i_aij)) then call div_mn(p%aij,p%diva,p%aa) else call div_other(f(:,:,:,iax:iaz),p%diva) endif ! ! Possibility of vector potential in Coulomb gauge as auxiliary output. ! Compute Acou=AWeyl-gLam, where div(Acou)=0=div(AWeyl)-del2(gLam). ! Recall that no minus sign has been included in the calculation of gLam. ! if (lcoulomb) then f(l1:l2,m,n,idiva)=p%diva if (lpenc_loc(i_gLam)) call grad(f,iLam,p%gLam) 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. ! 2026-Feb-20/Kishore: I have now checked that curl_other, curl_mn, curl, ! and curl_i give the same results, and so have removed ! the pencil-check workaround. elseif (lpenc_loc(i_aij)) 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. ! This lhubble_magnetic should not be applied unless we work ! with physical rather than scaled quantities. ! 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 !AB: comment out now ! 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) p%bb(:,3) = p%bb(:,3) + Bz_stratified(n) ! ! 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 ! ! The following is also computed if there is no displacement current. ! 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) if (lcurlb_as_aux) f(l1:l2,m,n,icurlbx:icurlbz)=p%curlb 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 ! ! In 0-D, initialize to p%bij to bij_0D_test ! if (dimensionality == 0 .or. lbij_test) then do i = 1,nx; p%bij(i,:,:)=bij_0D_test; enddo 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 call get_eta_t_and_xtdep(f,p) ! ! 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 (ldisp_current) 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. ! learly_set_el_pencil=T is needed in all cases with displacement current. ! if (lresi_eta_tdep .or. lresi_eta_xtdep .or. eta/=0.) then if (lohm_evolve) then p%jj_ohm=f(l1:l2,m,n,ijx:ijz) else if (learly_set_el_pencil) then if (iex /=0 ) then p%el=f(l1:l2,m,n,iex:iez) endif endif 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 and p%jj is set to mu01*p%curlb. ! 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) ! ! Compute Alfven speed. Take scale factor (=1 by default) into account. ! In general, the ascale factor is given by ascale**(2*nconformal-3). ! va2 ! if (lpenc_loc(i_va2)) then if (ascale==1.) then p%va2=p%b2*mu01*p%rho1 else p%va2=ascale**(2.*nconformal-3.)*p%b2*mu01*p%rho1 endif 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. ! To check whether scale factor is consistently applied at the end. ! 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 = B_{i,j} B_j = B.gradB ! 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 ! ! ljxb_as_aux is sometimes used to construct a "kinematic" velocity ! field, i.e., one that does not obey the Navier-Stokes equation. ! In that case it can be of interest to use just B.gradB instead, i.e., ! omit -grad(B^2/2). This can be done by using luse_bgb_as_jxb=T. ! The default is luse_bgb_as_jxb=F. ! if (ljxb_as_aux) then if (luse_bgb_as_jxb) then f(l1:l2,m,n,ijxbx:ijxbz)=p%bgb else f(l1:l2,m,n,ijxbx:ijxbz)=p%jxb endif endif ! ! Take p%bb_sph from auxiliary array, if it is defined. ! 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.(.not.lkinematic).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 ! ! Compute Alfven timestep constraint. Take scale factor (=1 by default) into account. ! In general, the ascale factor is given by ascale**(2*nconformal-3). ! if (ascale==1.) then p%advec_va2=sum((p%bb*dline_1)**2,2)*mu01*rho1_jxb else p%advec_va2=ascale**(2.*nconformal-3.)*sum((p%bb*dline_1)**2,2)*mu01*rho1_jxb endif 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 ! ! 23-feb-12/axel: added diamagnetism ! use Sub ! real, dimension (nx) :: chi_diamag real, dimension (nx,3) :: gchi_diamag, 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 calc_eta_total(f,p) real, dimension(mx,my,mz,mfarray) :: f type(pencil_case), intent(IN) :: p real, dimension(nx) :: eta_mn real, dimension(nx,3) :: geta eta_total = 0.0 if (lresi_shell) then call eta_shell(p,eta_mn,geta) eta_total = eta_total + eta_mn endif if (lresi_eta_tdep .or. lresi_eta_xtdep .or. lresi_hyper2_tdep .or. lresi_hyper3_tdep) then call get_eta_t_and_xtdep(f,p) if (ldisp_current) then if (lresi_eta_tdep) then eta_total = eta_tdep elseif (lresi_eta_xtdep) then eta_total=eta_xtdep endif endif endif if (lresi_eta_const) then eta_total = eta_total + eta endif endsubroutine calc_eta_total !*********************************************************************** 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 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 check whether ldisp_current=T. ! if ((.not. ldisp_current) .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_vector(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 ! ! Generalized 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) ! ! 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 ! ! 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) ! It should usually not be applied. ! if (lhubble_magnetic) then dAdt = dAdt - 2.*Hubble*ascale**1.5*p%AA call fatal_error('daa_dt','setting lhubble_magnetic=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) ! ! 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 .and. lfirst) then if (headtt) print*,'f(l1:l2,m,n,iex:iez)=-dAdt is set' f(l1:l2,m,n,iex:iez)=-df(l1:l2,m,n,iax:iaz) endif ! ! 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) 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 ! ! The following is the endif from "((.not. ldisp_current) .or. loverride_ee) then" ! endif ! ! If ldensity and ldensity_add_je_heating, then compute J.E and add it: ! if (ldensity .and. ldensity_add_je_heating) then if (ldisp_current) then call dot(p%jj,p%el,tmp1) if (je_heating_factor/=1.) tmp1=tmp1*je_heating_factor df(l1:l2,m,n,ilnrho)=df(l1:l2,m,n,ilnrho)+tmp1*p%rho1 else call fatal_error('daa_dt','J.E heating not programmed yet') endif 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_diagnostic_auxiliaries_magnetic(f,p) ! ! Insert the calculation of diagnostic auxiliaries here to ensure they end correctly ! in the snapshot with GPU-accelerated runs. ! Will be called from calc_diagnostics_magnetic and when snapshots are to be written. ! real, dimension(:,:,:,:) :: f type(pencil_case) :: p ! ! Possibility of vector potential in Coulomb gauge as auxiliary output. ! Compute Acou=AWeyl-gLam, where div(Acou)=0=div(AWeyl)-del2(gLam). ! Recall that no minus sign has been included in the calculation of gLam. ! if (laa_cou_as_aux) f(l1:l2,m,n,iacoux:iacouz)=p%aa-p%gLam endsubroutine calc_diagnostic_auxiliaries_magnetic !****************************************************************************** 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 call calc_diagnostic_auxiliaries_magnetic(f,p) ! ! 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 !test !if (laa_cou_as_aux) f(l1:l2,m,n,iacoux:iacouz)=p%aa+p%gLam ! call calc_2d_diagnostics_magnetic(p) call calc_1d_diagnostics_magnetic(p) if (ldiagnos) call calc_0d_diagnostics_magnetic(f,p) ! if (lvideo.and.lfirst) then ! ! Possibility of bij as auxiliary array ! if (lbij_as_aux) then f(l1:l2,m,n,ibij :ibij+2)=p%bij(:,:,1) f(l1:l2,m,n,ibij+3:ibij+5)=p%bij(:,:,2) f(l1:l2,m,n,ibij+6:ibij+8)=p%bij(:,:,3) endif ! ! Write slices for output in wvid in run.f90. ! 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((offset_min_calc-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 magnetic field in time, dotted with current density, 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_b8m/=0) call sum_mn_name(p%b2**4,idiag_b8m,llog10=.true.) if (idiag_b12m/=0) call sum_mn_name(p%b2**6,idiag_b12m,llog10=.true.) if (idiag_logbm/=0) call sum_mn_name(log(p%b2)/2,idiag_logbm) 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) if (idiag_bbxmax/=0) call max_mn_name(abs(p%bbb(:,1)),idiag_bbxmax) if (idiag_bbymax/=0) call max_mn_name(abs(p%bbb(:,2)),idiag_bbymax) if (idiag_bbzmax/=0) call max_mn_name(abs(p%bbb(:,3)),idiag_bbzmax) if (idiag_jxmax/=0) call max_mn_name(abs(p%jj(:,1)),idiag_jxmax) if (idiag_jymax/=0) call max_mn_name(abs(p%jj(:,2)),idiag_jymax) if (idiag_jzmax/=0) 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_acbm/=0) then call dot(f(l1:l2,m,n,iacoux:iacouz),p%bb,tmp) call sum_mn_name(tmp,idiag_acbm) endif 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, . ! if (idiag_fbm/=0.and.lforcing_cont_aa) 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 , and mean components of the correlation matrix . ! 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) = - + . ! if (idiag_bsinphz/=0) call sum_mn_name(-p%bbb(:,1)*sinkz(n)+p%bbb(:,2)*coskz(n),idiag_bsinphz) ! ! Calculate B*cos(phi) = + . ! 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) if (idiag_jxbrqm/=0) then call dot(p%curlo,p%jxbr,jxbrq) call sum_mn_name(jxbrq,idiag_jxbrqm) endif call sum_mn_name(p%jxbr2,idiag_jxbr2m) call max_mn_name(p%jxbr2,idiag_jxbrmax,lsqrt=.true.) ! ! 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) if (lmultithread .and. (idiag_epsM /= 0 .or. idiag_epsM2 /= 0 & .or. idiag_epsM3 /= 0 .or. idiag_epsM4 /= 0 .or. idiag_dteta /= 0)) then call calc_eta_total(f,p) if(idiag_dteta /= 0) diffus_eta =eta_total *dxyz_2 endif ! ! ! 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 (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 if (.not.lmultithread) then if (idiag_epsM_LES/=0) call sum_mn_name(eta_smag*p%j2,idiag_epsM_LES) 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 (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) ! ! 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 ! ! 's, 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%aa(:,3)**2,idiag_az2m) 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 /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 .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 _rms, _rms, _rms. ! call sum_mn_name(p%uxb2,idiag_uxBrms,lsqrt=.true.) ! ! Calculate , which is part of . ! Note that =1/2*+. ! if (idiag_b2divum/=0) call sum_mn_name(p%b2*p%divu,idiag_b2divum) ! ! Calculate . ! if (idiag_jdel2am/=0) then call dot(p%jj,p%del2a,jdel2a) call sum_mn_name(jdel2a,idiag_jdel2am) endif ! ! Calculate WL2D = . ! if (idiag_WL2D/=0) then call dot(p%jj,p%uga,tmp) call sum_mn_name(tmp,idiag_WL2D) endif ! ! Calculate WL3D = -. ! 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 = . ! 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 ! ! <(nabla B)^2> ! if (idiag_gb2m/=0) then call sum_mn_name(p%bij(:,1,1)**2+p%bij(:,1,2)**2+p%bij(:,1,3)**2 & +p%bij(:,2,1)**2+p%bij(:,2,2)**2+p%bij(:,2,3)**2 & +p%bij(:,3,1)**2+p%bij(:,3,2)**2+p%bij(:,3,3)**2,idiag_gb2m) 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 . ! if (idiag_jem/=0) then call dot(p%jj,p%el,tmp) call sum_mn_name(tmp,idiag_jem) endif ! ! Calculate . ! if (idiag_aem/=0) then call dot(p%aa,p%el,tmp) call sum_mn_name(tmp,idiag_aem) endif ! ! Calculate . ! call sum_mn_name(p%ujxb,idiag_ujxbm) ! ! Calculate _\|. ! call sum_mn_name(p%ubgbp,idiag_ubgbpm) ! ! Calculate . ! call sum_mn_name(p%ugb22,idiag_ugb22m) ! ! Calculate .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= ! if (idiag_b3b21m/=0) then b3b21=p%bb(:,3)*p%bij(:,2,1) call sum_mn_name(b3b21,idiag_b3b21m) endif ! ! alpM11= ! if (idiag_b3b12m/=0) then b3b12=p%bb(:,3)*p%bij(:,1,2) call sum_mn_name(b3b12,idiag_b3b12m) endif ! ! alpM22= ! if (idiag_b1b32m/=0) then b1b32=p%bb(:,1)*p%bij(:,3,2) call sum_mn_name(b1b32,idiag_b1b32m) endif ! ! alpM22= ! if (idiag_b1b23m/=0) then b1b23=p%bb(:,1)*p%bij(:,2,3) call sum_mn_name(b1b23,idiag_b1b23m) endif ! ! alpM33= ! if (idiag_b2b13m/=0) then b2b13=p%bb(:,2)*p%bij(:,1,3) call sum_mn_name(b2b13,idiag_b2b13m) endif ! ! alpM33= ! 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, curl_mn 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%j2, idiag_j2mx) call yzsum_mn_name_x(p%jb, idiag_jbmx) call yzsum_mn_name_x(p%b2*ymask_mag(m-m1+1), idiag_b2mmx) 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 _{xy}. ! if (idiag_bdel2amz/=0) then call dot(p%bb,p%del2a,bdel2a) call xysum_mn_name_z(bdel2a,idiag_bdel2amz) endif ! ! Calculate _{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 (lforcing_cont_aa) then call dot(p%bb,p%curlfcont(:,:,iforcing_cont_aa),tmp1) call xysum_mn_name_z(ampl_fcont_aa*mu01*tmp1,idiag_bcurlfmz) endif 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_brcmphi/=0) call phisum_mn_name_rz(p%pomx*(p%bb(:,1)*p%pomx+p%bb(:,2)*p%pomy),idiag_brcmphi) if (idiag_brsmphi/=0) call phisum_mn_name_rz(p%pomy*(p%bb(:,1)*p%pomx+p%bb(:,2)*p%pomy),idiag_brsmphi) 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_bpcmphi/=0) call phisum_mn_name_rz(p%pomx*(p%bb(:,1)*p%phix+p%bb(:,2)*p%phiy),idiag_bpcmphi) if (idiag_bpsmphi/=0) call phisum_mn_name_rz(p%pomy*(p%bb(:,1)*p%phix+p%bb(:,2)*p%phiy),idiag_bpsmphi) if (idiag_bp2mphi/=0) call phisum_mn_name_rz((p%bb(:,1)*p%phix+p%bb(:,2)*p%phiy)**2,idiag_bp2mphi) if (idiag_bzmphi/=0) call phisum_mn_name_rz(p%bb(:,3),idiag_bzmphi) if (idiag_bzcmphi/=0) call phisum_mn_name_rz(p%pomx*p%bb(:,3),idiag_bzcmphi) if (idiag_bzsmphi/=0) call phisum_mn_name_rz(p%pomy*p%bb(:,3),idiag_bzsmphi) 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 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 ! ! reset bbt etc. if lreset_vart=.true. ! To avoid resetting the time integration for each run, we must set ! ltime_integrals_always=T. But because tstart is being reset for each ! run (which is weird), we initialize the variables to zero when t>dt. ! This would not be correct if the initial tstart was different from 0, ! or if dt is negative (i.e., for backward in time integration). ! lreset_vart = .false. if (ltime_integrals_always .or. nint(dtcor)<=0.) then if (lreset_vart_only_at_start) then if (t and . ! The latter is calculated as - ! 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 ! 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 - ! 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 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_PENCIL 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_PENCIL) ! ! 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 !*********************************************************************** !NOT USED SO ON COMMENT ! 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) ! ! 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 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 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 = cos(kz) and s = sin(kz) ! and determine phase of Beltrami field from ! 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 = cos(kz) and s = sin(kz) ! and determine phase of Beltrami field from ! 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, amplu real, dimension (nx) :: rho,ampl_Az ! ! Amplitude factors ! ampl_lr=+0. ampl_ux=+0. ! ! Apply scale factor in initial condition (to do the same for the other directions). ! Assume that a^{n-3/2}*vA_phys = const, then amplu = ampl*ascale**(n-3/2). ! if (ascale_type=='general') then amplu=ampl*ascale**(nconformal-1.5) else amplu=ampl endif ! ! Special scale if there are also sound waves. ! if (ldensity) then if (lconservative) then ampl_uy=+amplu*sqrt(4./3.+B_ext2) elseif (lrelativistic_eos) then ampl_uy=+amplu*sqrt(.75) else ampl_uy=+amplu endif endif if (lroot) print*,'ampl_uy,ascale=',ampl_uy,ascale ! ! 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, amplu, ky, mu0 integer :: iuu,iaa ! ! Apply scale factor in initial condition (to do the same for the other directions) ! Assume that a^{n-3/2}*vA_phys = const, then amplu = ampl*ascale**(n-3/2). ! if (ascale_type=='general') then amplu=ampl*ascale**(nconformal-1.5) else amplu=ampl endif ! ! ux and Az ! do n=n1,n2; do m=m1,m2 f(l1:l2,m,n,iuu+0) = +amplu*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, amplu, kz, mu0 integer :: iuu,iaa ! ! Apply scale factor in initial condition (to do the same for the other directions) ! Assume that a^{n-3/2}*vA_phys = const, then amplu = ampl*ascale**(n-3/2). ! if (ascale_type=='general') then amplu=ampl*ascale**(nconformal-1.5) else amplu=ampl endif ! ! ux and Ay ! do n=n1,n2; do m=m1,m2 f(l1:l2,m,n,iuu+0)=+amplu*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)=real(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 rR_ext, and potential in the shell R_intr_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) 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. Note that x0 is the left boundary. ! 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 ! ! Powerlaw-x3: ! case ('powerlaw-x3','powerlaw_x3') ! ! eta proportional to chosen power of x. ! Similar to powerlaw-x2, but regularized for x < eta_x0. ! eta_x = eta*(1.+x/eta_x0)**eta_power_x ! ! ... and its gradient; same as for powerlaw-x. ! geta_x = eta_power_x*eta_x/(eta_x0+x) ! 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_b8m=0; idiag_b12m=0; idiag_logbm=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_acbm=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_az2m=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_j2mx=0; idiag_jbmx=0 idiag_b2mmx=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_bcurlfmz=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_bx2mxz=0; idiag_by2mxz=0; idiag_bz2mxz=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_gb2m=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_brcmphi=0; idiag_brsmphi=0; idiag_bpcmphi=0; idiag_bpsmphi=0; idiag_bzcmphi=0; idiag_bzcmphi=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),'acbm',idiag_acbm) 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),'b8m',idiag_b8m) call parse_name(iname,cname(iname),cform(iname),'b12m',idiag_b12m) call parse_name(iname,cname(iname),cform(iname),'logbm',idiag_logbm) 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),'az2m',idiag_az2m) 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),'gb2m',idiag_gb2m) 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),'j2mx',idiag_j2mx) call parse_name(inamex,cnamex(inamex),cformx(inamex),'jbmx',idiag_jbmx) call parse_name(inamex,cnamex(inamex),cformx(inamex),'b2mmx',idiag_b2mmx) 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),'bcurlfmz',idiag_bcurlfmz) 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),'brcmphi' ,idiag_brcmphi) call parse_name(irz,cnamerz(irz),cformrz(irz),'brsmphi' ,idiag_brsmphi) call parse_name(irz,cnamerz(irz),cformrz(irz),'bpcmphi' ,idiag_bpcmphi) call parse_name(irz,cnamerz(irz),cformrz(irz),'bpsmphi' ,idiag_bpsmphi) call parse_name(irz,cnamerz(irz),cformrz(irz),'bzcmphi' ,idiag_bzcmphi) call parse_name(irz,cnamerz(irz),cformrz(irz),'bzsmphi' ,idiag_bzsmphi) 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 call keep_compiler_quiet(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 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 !******************************************************************** !NOT USED SO ON COMMENT ! ! 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 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=500 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 call copy_addr(lrhs_max,p_par(261)) ! bool run_const call copy_addr(gamma1,p_par(262)) ! real run_const 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)) call copy_addr(eta_tdep_ascale_power,p_par(268)) call copy_addr(lremove_meanaxy,p_par(269)) ! bool call copy_addr(tau_remove_meanaxy,p_par(270)) call copy_addr(je_heating_factor,p_par(271)) call copy_addr(ldensity_add_je_heating,p_par(272)) ! bool call copy_addr(ltime_integrals_always,p_par(273)) ! bool call copy_addr(lvart_in_shear_frame,p_par(274)) ! bool call copy_addr(dtcor,p_par(275)) call copy_addr(lcurlb_as_aux,p_par(276)) ! bool call copy_addr(lbij_as_aux,p_par(277)) ! bool call copy_addr(bij_0d_test,p_par(278)) ! (3) (3) call copy_addr(lbij_test,p_par(279)) ! bool call copy_addr(luse_bgb_as_jxb,p_par(280)) ! bool call copy_addr(lreset_vart_only_at_start,p_par(281)) ! bool call copy_addr(enum_div_sld_magn,p_par(282)) ! int endsubroutine pushpars2c !*********************************************************************** endmodule Magnetic