! $Id$ ! ! This module provides a 1D profile of density and temperature for the ! initial conditions to be applied for supernova driven turbulence ! simulations in the interstellar medium. ! After the 1D profile converges to an equilibrium state save the profiles ! of rho and tt to init_ism.dat, which will be imported by ! initial_condition/ths_equilibrium_ism.f90 for 3D simulations ! ! Description | Relevant function call ! ------------------------------------------------------------------------ ! Initial condition registration | register_initial_condition ! (pre parameter read) | ! Initial condition initialization | initialize_initial_condition ! (post parameter read) | ! | ! Initial condition for momentum | initial_condition_uu ! Initial condition for density | initial_condition_lnrho ! Initial condition for entropy | initial_condition_ss ! Initial condition for magnetic potential | initial_condition_aa ! | ! Initial condition for all in one call | initial_condition_all ! (called last) | ! ! And a similar subroutine for each module with an "init_XXX" call. ! The subroutines are organized IN THE SAME ORDER THAT THEY ARE CALLED. ! First uu, then lnrho, then ss, then aa, and so on. ! !** 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 :: linitial_condition = .true. ! !*************************************************************** ! ! HOW TO USE THIS FILE ! -------------------- ! ! Change the line above to ! linitial_condition = .true. ! to enable use of custom initial conditions. ! ! The rest of this file may be used as a template for your own initial ! conditions. Simply fill out the prototypes for the features you want ! to use. ! ! Save the file with a meaningful name, e.g. mhs_equilibrium.f90, and ! place it in the $PENCIL_HOME/src/initial_condition directory. This ! path has been created to allow users to optionally check their ! contributions in to the Pencil Code SVN repository. This may be ! useful if you are working on/using an initial condition with ! somebody else or may require some assistance from one from the main ! Pencil Code team. HOWEVER, less general initial conditions should ! not go here (see below). ! ! You can also place initial condition files directly in the run ! directory. Simply create the folder 'initial_condition' at the same ! level as the *.in files and place an initial condition file there. ! With pc_setupsrc this file is linked automatically into the local ! src directory. This is the preferred method for initial conditions ! that are not very general. ! ! To use your additional initial condition code, edit the ! Makefile.local in the src directory under the run directory in which ! you wish to use your initial condition. Add a line that says e.g. ! ! INITIAL_CONDITION = initial_condition/mhs_equilibrium ! ! Here mhs_equilibrium is replaced by the filename of your new file, ! not including the .f90 extension. ! ! This module is based on Tony's special module. ! module InitialCondition ! use Cparam use Cdata use General, only: keep_compiler_quiet use Messages ! implicit none ! include '../initial_condition.h' ! ! Observed number density per cubic cm parameters from Dickey & Lockman ! Includes neutral hydrogen and warm ionized hydrogen plus helium ! proportionately. Multiply by m_u_cgs for gas density ! ! particles per cm cubed not normalized to 1 at midplane real, parameter, dimension(5) :: nfraction_cgs = & (/0.399,0.1083,0.0627,0.015,0.025/) ! scale height in cm real, parameter, dimension(5) :: hscale_cgs = & (/3.9188e20, 9.8125e20, 1.2435e21, 2.1600e20, 2.7771e21/) real, dimension(5) :: rho_fraction, hscale ! ! Heating function, cooling function ! character (len=labellen) :: heating_select = 'wolfire' character (len=labellen) :: cooling_select = 'WSW' ! ! TT & rho z-dependent profiles ! real, parameter :: T_init_cgs=1e3 real :: T_init=impossible real :: rhox=1. ! column density comparative to Milky Way default real :: He_factor=1.101 !number density rescale for helium real, dimension(mz) :: rho, lnTT ! ! start parameters ! namelist /initial_condition_pars/ & T_init, cooling_select, rhox, HE_factor, & heating_select ! contains !*********************************************************************** subroutine register_initial_condition() ! ! Register variables associated with this module; likely none. ! ! 07-may-09/wlad: coded ! if (lroot) call svn_id( & "$Id$") ! endsubroutine register_initial_condition !*********************************************************************** subroutine initialize_initial_condition(f) ! ! Initialize any module variables which are parameter dependent. ! ! 07-may-09/wlad: coded ! real, dimension (mx,my,mz,mfarray) :: f ! call keep_compiler_quiet(f) ! endsubroutine initialize_initial_condition !*********************************************************************** subroutine initial_condition_all(f,profiles) ! ! Initializes all the f arrays in one call. This subroutine is called last. ! ! 21-dec-10/ccyang: coded ! 15-feb-15/MR: optional parameter 'profiles' added ! use Messages, only: fatal_error use EquationOfState, only: getmu, eoscalc ! real, dimension (mx,my,mz,mfarray), optional, intent(inout):: f real, dimension (:,:), optional, intent(out) :: profiles ! ! SAMPLE IMPLEMENTATION ! call keep_compiler_quiet(f) if (present(profiles)) then call fatal_error('initial_condition_all', & 'If profiles are asked for, a real initial condition must be specified') call keep_compiler_quiet(profiles) endif ! endsubroutine initial_condition_all !***************************************************************************** subroutine initial_condition_uu(f) ! ! Initialize the velocity field. ! ! 07-may-09/wlad: coded ! real, dimension (mx,my,mz,mfarray), intent(inout) :: f ! f(:,:,:,iuu:iuu+2) = 0. ! call keep_compiler_quiet(f) ! endsubroutine initial_condition_uu !*********************************************************************** subroutine initial_condition_lnrho(f) ! ! Initialize logarithmic density. init_lnrho will take care of ! converting it to linear density if you use ldensity_nolog. ! ! 07-jul-15/fred: coded ! use EquationOfState, only: getmu, get_cp1 ! real, dimension (mx,my,mz,mfarray), intent(inout) :: f ! ! Set up physical units. ! if (unit_system=='cgs') then rho_fraction = rhox * He_factor*nfraction_cgs * m_u_cgs/unit_density hscale = hscale_cgs/unit_length if (T_init == impossible) T_init = T_init_cgs/unit_temperature else if (unit_system=='SI') then call fatal_error('initial_condition_lnrho','SI unit conversions not inplemented') endif ! lnTT = log(T_init) rho = rho_fraction(1) * exp(-z**2/hscale(1)**2) & + rho_fraction(2) * exp(-z**2/hscale(2)**2) & + rho_fraction(3) * exp(-abs(z)/hscale(3)) & + rho_fraction(4) * exp(-abs(z)/hscale(4)) & + rho_fraction(5) * exp(-abs(z)/hscale(5)) do n=n1,n2 f(:,:,n,ilnrho)=log(rho(n)) enddo ! endsubroutine initial_condition_lnrho !*********************************************************************** subroutine initial_condition_ss(f) ! ! Initialize entropy. ! ! 07-may-09/wlad: coded ! use EquationOfState, only: eoscalc, ilnrho_lnTT ! real, dimension (mx,my,mz,mfarray), intent(inout) :: f real :: lnrho, ss ! do n=n1,n2 if (ldensity_nolog) then lnrho=log(f(l1,m1,n,irho)) else lnrho=f(l1,m1,n,ilnrho) endif ! call eoscalc(ilnrho_lnTT,lnrho,lnTT(n),ss=ss) ! f(:,:,n,iss)=ss ! enddo ! endsubroutine initial_condition_ss !*********************************************************************** subroutine initial_condition_aa(f) ! ! Initialize the magnetic vector potential. ! ! 07-may-09/wlad: coded ! real, dimension (mx,my,mz,mfarray), intent(inout) :: f ! ! SAMPLE IMPLEMENTATION ! call keep_compiler_quiet(f) ! endsubroutine initial_condition_aa !*********************************************************************** subroutine initial_condition_aatest(f) ! ! Initialize testfield. ! ! 07-may-09/wlad: coded ! real, dimension (mx,my,mz,mfarray), intent(inout) :: f ! call keep_compiler_quiet(f) ! endsubroutine initial_condition_aatest !*********************************************************************** subroutine initial_condition_uutest(f) ! ! Initialize testflow. ! ! 07-may-09/wlad: coded ! real, dimension (mx,my,mz,mfarray), intent(inout) :: f ! call keep_compiler_quiet(f) ! endsubroutine initial_condition_uutest !*********************************************************************** subroutine initial_condition_lncc(f) ! ! Initialize passive scalar. ! ! 07-may-09/wlad: coded ! real, dimension (mx,my,mz,mfarray), intent(inout) :: f ! call keep_compiler_quiet(f) ! endsubroutine initial_condition_lncc !*********************************************************************** subroutine initial_condition_chiral(f) ! ! Initialize chiral. ! ! 07-may-09/wlad: coded ! real, dimension (mx,my,mz,mfarray), intent(inout) :: f ! call keep_compiler_quiet(f) ! endsubroutine initial_condition_chiral !*********************************************************************** subroutine initial_condition_chemistry(f) ! ! Initialize chemistry. ! ! 07-may-09/wlad: coded ! real, dimension (mx,my,mz,mfarray), intent(inout) :: f ! call keep_compiler_quiet(f) ! endsubroutine initial_condition_chemistry !*********************************************************************** subroutine initial_condition_uud(f) ! ! Initialize dust fluid velocity. ! ! 07-may-09/wlad: coded ! real, dimension (mx,my,mz,mfarray), intent(inout) :: f ! call keep_compiler_quiet(f) ! endsubroutine initial_condition_uud !*********************************************************************** subroutine initial_condition_nd(f) ! ! Initialize dust fluid density. ! ! 07-may-09/wlad: coded ! real, dimension (mx,my,mz,mfarray), intent(inout) :: f ! call keep_compiler_quiet(f) ! endsubroutine initial_condition_nd !*********************************************************************** subroutine initial_condition_uun(f) ! ! Initialize neutral fluid velocity. ! ! 07-may-09/wlad: coded ! real, dimension (mx,my,mz,mfarray), intent(inout) :: f ! call keep_compiler_quiet(f) ! endsubroutine initial_condition_uun !*********************************************************************** subroutine initial_condition_lnrhon(f) ! ! Initialize neutral fluid density. ! ! 07-may-09/wlad: coded ! real, dimension (mx,my,mz,mfarray), intent(inout) :: f ! call keep_compiler_quiet(f) ! endsubroutine initial_condition_lnrhon !*********************************************************************** subroutine initial_condition_ecr(f) ! ! Initialize cosmic rays. ! ! 07-may-09/wlad: coded ! real, dimension (mx,my,mz,mfarray), intent(inout) :: f ! call keep_compiler_quiet(f) ! endsubroutine initial_condition_ecr !*********************************************************************** subroutine initial_condition_fcr(f) ! ! Initialize cosmic ray flux. ! ! 07-may-09/wlad: coded ! real, dimension (mx,my,mz,mfarray), intent(inout) :: f ! call keep_compiler_quiet(f) ! endsubroutine initial_condition_fcr !*********************************************************************** subroutine initial_condition_solid_cells(f) ! ! Initialize solid cells. ! ! 07-may-09/wlad: coded ! real, dimension (mx,my,mz,mfarray), intent(inout) :: f ! call keep_compiler_quiet(f) ! endsubroutine initial_condition_solid_cells !*********************************************************************** subroutine initial_condition_cctest(f) ! ! Initialize testscalar. ! ! 07-may-09/wlad: coded ! real, dimension (mx,my,mz,mfarray), intent(inout) :: f ! call keep_compiler_quiet(f) ! endsubroutine initial_condition_cctest !*********************************************************************** subroutine initial_condition_xxp(f,fp) ! ! Initialize particles' positions. ! ! 07-may-09/wlad: coded ! real, dimension (mx,my,mz,mfarray), intent(inout) :: f real, dimension (:,:), intent(inout) :: fp ! call keep_compiler_quiet(f) call keep_compiler_quiet(fp) ! endsubroutine initial_condition_xxp !*********************************************************************** subroutine initial_condition_vvp(f,fp) ! ! Initialize particles' velocities. ! ! 07-may-09/wlad: coded ! real, dimension (mx,my,mz,mfarray), intent(inout) :: f real, dimension (:,:), intent(inout) :: fp ! call keep_compiler_quiet(f) call keep_compiler_quiet(fp) ! endsubroutine initial_condition_vvp !*********************************************************************** subroutine read_initial_condition_pars(iostat) ! use File_io, only: parallel_unit ! integer, intent(out) :: iostat ! read(parallel_unit, NML=initial_condition_pars, IOSTAT=iostat) ! endsubroutine read_initial_condition_pars !*********************************************************************** subroutine write_initial_condition_pars(unit) ! integer, intent(in) :: unit ! write(unit, NML=initial_condition_pars) ! endsubroutine write_initial_condition_pars !*********************************************************************** subroutine initial_condition_clean_up ! ! 04-may-11/dhruba: coded ! dummy ! endsubroutine initial_condition_clean_up !*********************************************************************** !*********************************************************************** ! !******************************************************************** !************ DO NOT DELETE THE FOLLOWING ************** !******************************************************************** !** This is an automatically generated include file that creates ** !** copies dummy routines from noinitial_condition.f90 for any ** !** InitialCondition routines not implemented in this file ** !** ** include '../initial_condition_dummies.inc' !******************************************************************** endmodule InitialCondition