read_neutral_population Subroutine

public subroutine read_neutral_population(id, pop, error)

Reads neutral population from file

Arguments

TypeIntentOptionalAttributesName
integer(kind=HID_T), intent(in) :: id

HDF5 id

type(NeutralPopulation), intent(inout) :: pop

Neutral Population to populate

integer, intent(out) :: error

Error code


Calls

proc~~read_neutral_population~~CallsGraph proc~read_neutral_population read_neutral_population h5gopen_f h5gopen_f proc~read_neutral_population->h5gopen_f proc~init_neutral_population init_neutral_population proc~read_neutral_population->proc~init_neutral_population proc~ind2sub ind2sub proc~read_neutral_population->proc~ind2sub h5ltread_dataset_int_f h5ltread_dataset_int_f proc~read_neutral_population->h5ltread_dataset_int_f proc~h5ltread_dataset_int_scalar_f h5ltread_dataset_int_scalar_f proc~read_neutral_population->proc~h5ltread_dataset_int_scalar_f h5ltread_dataset_double_f h5ltread_dataset_double_f proc~read_neutral_population->h5ltread_dataset_double_f h5gclose_f h5gclose_f proc~read_neutral_population->h5gclose_f proc~init_reservoir init_reservoir proc~read_neutral_population->proc~init_reservoir proc~h5ltread_dataset_int_scalar_f->h5ltread_dataset_int_f interface~randu randu proc~init_reservoir->interface~randu

Called by

proc~~read_neutral_population~~CalledByGraph proc~read_neutral_population read_neutral_population proc~read_neutrals read_neutrals proc~read_neutrals->proc~read_neutral_population program~fidasim fidasim program~fidasim->proc~read_neutrals

Contents


Source Code

subroutine read_neutral_population(id, pop, error)
    !+ Reads neutral population from file
    integer(HID_T), intent(in) :: id
        !+ HDF5 id
    type(NeutralPopulation), intent(inout) :: pop
        !+ Neutral Population to populate
    integer, intent(out) :: error
        !+ Error code

    integer(HID_T) :: gid
    integer(HSIZE_T), dimension(4) :: dims4
    integer(HSIZE_T), dimension(5) :: dims5

    integer :: k, nx, ny, nz, ic, ind(3), ii, jj, kk, ir
    real(Float64) :: amu
    integer(Int32), dimension(:,:,:), allocatable :: n
    real(Float64), dimension(:,:,:,:), allocatable :: w
    real(Float64), dimension(:,:,:,:,:), allocatable :: v

    call init_neutral_population(pop)

    nx = beam_grid%nx; ny = beam_grid%ny; nz = beam_grid%nz

    dims4 = [nlevs, nx, ny, nz]
    call h5ltread_dataset_double_f(id, "dens", pop%dens, dims4, error)

    call h5gopen_f(id, "reservoir", gid, error)
    k = reservoir_size
    call h5ltread_dataset_int_scalar_f(gid, "k", k, error)
    if (k.ne.reservoir_size) then
        if(inputs%verbose.ge.0) then
            write(*,'(a,a)') 'READ_NEUTRAL_POPULATION: Unsupported reservoir size: ',k, reservoir_size
        endif
        stop
    endif

    allocate(v(3,k,nx,ny,nz))
    allocate(w(k,nx,ny,nz))
    allocate(n(nx,ny,nz))
    w = 0.d0; v=0.d0; n=0

    dims5 = [3, k, nx, ny, nz]
    call h5ltread_dataset_double_f(gid, "v", v, dims5, error)
    call h5ltread_dataset_double_f(gid, "w", w, dims5(2:5), error)
    call h5ltread_dataset_int_f(gid, "n", n, dims4(2:4), error)

    call h5gclose_f(gid, error)

    do ic=1,beam_grid%ngrid
        call ind2sub(beam_grid%dims,ic,ind)
        ii = ind(1) ; jj = ind(2) ; kk = ind(3)
        call init_reservoir(pop%res(ii,jj,kk))
        pop%res(ii,jj,kk)%n = n(ii,jj,kk)
        do ir=1,min(k,pop%res(ii,jj,kk)%n)
            pop%res(ii,jj,kk)%R(ir) = NeutralParticle(w(ir,ii,jj,kk), v(:,ir,ii,jj,kk))
        enddo
    enddo

    deallocate(v,w,n)

end subroutine read_neutral_population