read_cfpd Subroutine

  1. fidasim.f90
  2. libfida
  3. read_cfpd

public subroutine read_cfpd()

Reads the CFPD geometry and stores the quantities in ctable

Arguments

None

Calls

proc~~read_cfpd~~CallsGraph proc~read_cfpd read_cfpd h5ltpath_valid_f h5ltpath_valid_f proc~read_cfpd->h5ltpath_valid_f h5gopen_f h5gopen_f proc~read_cfpd->h5gopen_f h5fopen_f h5fopen_f proc~read_cfpd->h5fopen_f h5fclose_f h5fclose_f proc~read_cfpd->h5fclose_f h5open_f h5open_f proc~read_cfpd->h5open_f proc~h5ltread_dataset_int_scalar_f h5ltread_dataset_int_scalar_f proc~read_cfpd->proc~h5ltread_dataset_int_scalar_f h5close_f h5close_f proc~read_cfpd->h5close_f h5ltread_dataset_string_f h5ltread_dataset_string_f proc~read_cfpd->h5ltread_dataset_string_f h5ltread_dataset_double_f h5ltread_dataset_double_f proc~read_cfpd->h5ltread_dataset_double_f h5gclose_f h5gclose_f proc~read_cfpd->h5gclose_f h5ltread_dataset_int_f h5ltread_dataset_int_f proc~h5ltread_dataset_int_scalar_f->h5ltread_dataset_int_f

Called by

proc~~read_cfpd~~CalledByGraph proc~read_cfpd read_cfpd program~fidasim fidasim program~fidasim->proc~read_cfpd

Contents

Source Code

read_cfpd

Source Code

subroutine read_cfpd
    !+ Reads the CFPD geometry and stores the quantities in [[libfida:ctable]]
    integer(HID_T) :: fid, gid
    integer(HSIZE_T), dimension(3) :: dims3
    integer(HSIZE_T), dimension(5) :: dims5
    logical :: path_valid
    real(Float64),dimension(3) :: uvwi,uvwf,rpzi,rpzf

    character(len=20) :: system = ''

    integer :: error

    !!Initialize HDF5 interface
    call h5open_f(error)

    !!Open HDF5 file
    call h5fopen_f(inputs%geometry_file, H5F_ACC_RDWR_F, fid, error)

    if(inputs%verbose.ge.1) write(*,'(a)') "---- CFPD settings ----"
    !!Check if CFPD group exists
    call h5ltpath_valid_f(fid, "/cfpd", .True., path_valid, error)
    if(.not.path_valid) then
        if(inputs%verbose.ge.0) then
            write(*,'(a)') 'CFPD geometry is not in the geometry file'
            write(*,'(a)') 'Continuing without CFPD diagnostics'
            write(*,*) ''
        endif
        inputs%calc_cfpd = 0
        call h5fclose_f(fid, error)
        call h5close_f(error)
        return
    endif

    !!Open CFPD group
    call h5gopen_f(fid, "/cfpd", gid, error)

    call h5ltread_dataset_string_f(gid, "/cfpd/system", system, error)
    call h5ltread_dataset_int_scalar_f(gid, "/cfpd/nchan", ctable%nchan, error)

    if(inputs%verbose.ge.1) then
        write(*,'(T2,"CFPD System: ", a)') trim(adjustl(system))
        write(*,'(T2,"Number of channels: ",i3)') ctable%nchan
    endif

    call h5ltread_dataset_int_scalar_f(gid,"/cfpd/nenergy", ctable%nenergy, error)
    call h5ltread_dataset_int_scalar_f(gid,"/cfpd/nrays", ctable%nrays, error)
    call h5ltread_dataset_int_scalar_f(gid,"/cfpd/nsteps", ctable%nsteps, error)

    allocate(ctable%earray(ctable%nenergy))
    allocate(ctable%nactual(ctable%nenergy, ctable%nrays, ctable%nchan))
    allocate(ctable%daomega(ctable%nenergy, ctable%nrays, ctable%nchan))
    allocate(ctable%sightline(ctable%nenergy, 6, ctable%nsteps, ctable%nrays, ctable%nchan))

    dims3 = [ctable%nenergy, ctable%nrays, ctable%nchan]
    dims5 = [ctable%nenergy, 6, ctable%nsteps, ctable%nrays, ctable%nchan]
    call h5ltread_dataset_double_f(gid, "/cfpd/earray", ctable%earray, dims3(1:1), error)
    call h5ltread_dataset_double_f(gid, "/cfpd/nactual", ctable%nactual, dims3, error)
    call h5ltread_dataset_double_f(gid, "/cfpd/daomega", ctable%daomega, dims3, error)
    call h5ltread_dataset_double_f(gid, "/cfpd/sightline", ctable%sightline, dims5, error)

    !!Close CFPD group
    call h5gclose_f(gid, error)

    !!Close file id
    call h5fclose_f(fid, error)

    !!Close HDF5 interface
    call h5close_f(error)

    rpzi(1) = ctable%sightline(1,4,1,1,1)
    rpzi(2) = ctable%sightline(1,5,1,1,1)
    rpzi(3) = ctable%sightline(1,6,1,1,1)
    rpzf(1) = ctable%sightline(1,4,2,1,1)
    rpzf(2) = ctable%sightline(1,5,2,1,1)
    rpzf(3) = ctable%sightline(1,6,2,1,1)

    uvwi(1) = rpzi(1)*cos(rpzi(2))
    uvwi(2) = rpzi(1)*sin(rpzi(2))
    uvwi(3) = rpzi(3)
    uvwf(1) = rpzf(1)*cos(rpzf(2))
    uvwf(2) = rpzf(1)*sin(rpzf(2))
    uvwf(3) = rpzf(3)
    ctable%dl = norm2(uvwf-uvwi)

    ctable%dE = ctable%earray(2)-ctable%earray(1)

    if(inputs%verbose.ge.1) write(*,'(50X,a)') ""

end subroutine read_cfpd