Area_SRad_BLE_T Derived Type

type, public, extends(Area_Rad_BLE_T) :: Area_SRad_BLE_T


Inherits

type~~area_srad_ble_t~~InheritsGraph type~area_srad_ble_t Area_SRad_BLE_T type~area_rad_ble_t Area_Rad_BLE_T type~area_srad_ble_t->type~area_rad_ble_t type~rad_le_t Rad_LE_T type~area_rad_ble_t->type~rad_le_t

Contents


Components

TypeVisibility AttributesNameInitial
character(len=512), public :: OutFile
logical, public :: PRNBat =.false.
real(kind=krs), public :: adfpmin
real(kind=krs), public :: anxr
real(kind=krs), public :: anyr
real(kind=krs), public :: difr0
real(kind=krs), public :: difr1
integer(kind=kis), public :: ntgt
real(kind=krd), public :: MeanTiming
integer(kind=kis), public :: npx
integer(kind=kis), public :: npy
integer(kind=kis), public :: npr
integer(kind=kis), public :: npgrd
real(kind=krs), public :: fpx
real(kind=krs), public :: fpy
real(kind=krs), public :: dpx
real(kind=krs), public :: dpy
real(kind=krs), public, allocatable:: PZps(:)
real(kind=krs), public, allocatable:: PVec(:,:)
real(kind=krs), public, allocatable:: Ppxy(:,:)
integer(kind=kis), public, allocatable:: PXIdLUT(:)
integer(kind=kis), public, allocatable:: PYIdLUT(:)
integer(kind=kis), public, allocatable:: PZId(:)
integer(kind=kis), public :: IdPG(2)
integer(kind=kis), public :: IdPR
real(kind=krd), public, allocatable:: PRad(:,:,:,:)
real(kind=krd), public, allocatable:: MeanPRad(:,:,:,:)
real(kind=krd), public, allocatable:: RMSEPRad(:,:,:,:)
real(kind=krd), public, allocatable:: MeanPRadNth(:,:,:,:,:)
real(kind=krd), public, allocatable:: RMSEPRadNth(:,:,:,:,:)

Type-Bound Procedures

procedure, public :: init_Rad_LE => init_Area_SRad_BLE

  • private function init_Area_SRad_BLE(this, prob, GeoGrd, SrcOPT, OutFile, err) result(istat)

    initialize area-averaged radiance estimators for scalar radiative transfer simulation with backward Monte Carlo algorithm

    Arguments

    Type IntentOptional AttributesName
    class(Area_SRad_BLE_T), intent(inout) :: this
    type(MSCART_Problem_T), intent(in) :: prob
    class(GeomGrid_T), intent(in) :: GeoGrd
    class(SrcOPT_T), intent(in) :: SrcOPT
    character(len=*), intent(in) :: OutFile
    type(erro_t), intent(inout) :: err

    Return Value integer(kind=kis)

procedure, public :: free_Rad_LE => free_Area_SRad_BLE

  • private function free_Area_SRad_BLE(this, err) result(istat)

    free memory of area-averaged radiance estimators for scalar radiative transfer simulation with backward Monte Carlo algorithm

    Arguments

    Type IntentOptional AttributesName
    class(Area_SRad_BLE_T), intent(inout) :: this
    type(erro_t), intent(inout) :: err

    Return Value integer(kind=kis)

procedure, public :: init_ncfile

  • private function init_ncfile(this, GeoGrd, SrcOPT, nbat, err) result(istat)

    initialize output results of area-averaged radiance estimators for scalar radiative transfer simulation with backward Monte Carlo algorithm in NETCDF format

    Arguments

    Type IntentOptional AttributesName
    class(Area_SRad_BLE_T), intent(inout) :: this
    class(GeomGrid_T), intent(in) :: GeoGrd
    class(SrcOPT_T), intent(in) :: SrcOPT
    integer(kind=kis), intent(in) :: nbat
    type(erro_t), intent(inout) :: err

    Return Value integer(kind=kis)

procedure, public :: estm_RadPsi => estm_Area_SRadPsi

  • private subroutine estm_Area_SRadPsi(this, itgt, photon, GeoGrd, AtmOPT, SrcOPT, istat, PFunTab, ftdcf, SfcOPT, pac)

    estimate area-averaged radiance contributions for scalar radiative transfer simulation using backward Monte Carlo algorithm

    Read more…

    Arguments

    Type IntentOptional AttributesName
    class(Area_SRad_BLE_T), intent(inout) :: this
    integer(kind=kis), intent(in) :: itgt
    type(photon_T), intent(in) :: photon
    class(GeomGrid_T), intent(in) :: GeoGrd
    class(AtmOPT_T), intent(in) :: AtmOPT
    class(SrcOPT_T), intent(in) :: SrcOPT
    integer(kind=kis), intent(in) :: istat
    class(PhsMatTab_T), intent(in), optional :: PFunTab
    real(kind=krs), intent(in), optional :: ftdcf
    class(SfcOPT_T), intent(in), optional :: SfcOPT
    real(kind=krs), intent(in), optional :: pac(:)

procedure, public :: sum_RadPsi_OneBatch => sum_Area_SRad_BLE_RadPsi_OneBatch

  • private subroutine sum_Area_SRad_BLE_RadPsi_OneBatch(this, SrcOPT, nPho, Timing)

    normalize and accumulate area-averaged radiance of each batch simulation of scalar radiative transfer using backward Monte Carlo algorithm

    Arguments

    Type IntentOptional AttributesName
    class(Area_SRad_BLE_T), intent(inout) :: this
    class(SrcOPT_T), intent(in) :: SrcOPT
    real(kind=krs), intent(in) :: nPho
    real(kind=krs), intent(in) :: Timing

procedure, public :: sum_RadPsi_AllBatch => sum_Area_SRad_BLE_RadPsi_AllBatch

  • private subroutine sum_Area_SRad_BLE_RadPsi_AllBatch(this, SrcOPT, nbat, nph)

    accumulate area-averaged radiance of all batch simulations of scalar radiative transfer using backward Monte Carlo algorithm

    Arguments

    Type IntentOptional AttributesName
    class(Area_SRad_BLE_T), intent(inout) :: this
    class(SrcOPT_T), intent(in) :: SrcOPT
    integer(kind=kis), intent(in) :: nbat
    real(kind=krs), intent(in) :: nph

procedure, public :: reset_RadPsi_OneBatch => reset_Area_SRad_BLE_PadPsi_OneBatch

  • private subroutine reset_Area_SRad_BLE_PadPsi_OneBatch(this)

    reset all variables of area-averaged radiance estimators zeros for scalar radiative transfer simulation with backward Monte Carlo algorithm

    Arguments

    Type IntentOptional AttributesName
    class(Area_SRad_BLE_T), intent(inout) :: this

procedure, public :: reset_RadPsi_AllBatch => reset_Area_SRad_BLE_PadPsi_AllBatch

  • private subroutine reset_Area_SRad_BLE_PadPsi_AllBatch(this)

    reset all variables of area-averaged radiance estimators zeros for scalar radiative transfer simulation with backward Monte Carlo algorithm

    Arguments

    Type IntentOptional AttributesName
    class(Area_SRad_BLE_T), intent(inout) :: this

procedure, public :: write_Rad_LE_result => write_Area_SRad_BLE_result

  • private function write_Area_SRad_BLE_result(this, SrcOPT, ibat, nPho, Timing, err) result(istat)

    write area-averaged radiance results of each batch simulation of scalar radiative transfer using backward Monte Carlo algorithm in netcdf format

    Arguments

    Type IntentOptional AttributesName
    class(Area_SRad_BLE_T), intent(inout) :: this
    class(SrcOPT_T), intent(in) :: SrcOPT
    integer(kind=kis), intent(in) :: ibat
    real(kind=krs), intent(in) :: nPho
    real(kind=krs), intent(in) :: Timing
    type(erro_t), intent(inout) :: err

    Return Value integer(kind=kis)

procedure, public :: write_Rad_LE_census => write_Area_SRad_BLE_census

  • private function write_Area_SRad_BLE_census(this, SrcOPT, nbat, nph, err) result(istat)

    write area-averaged radiance results of all batch simulations of scalar radiative transfer using backward Monte Carlo algorithm in netcdf format

    Read more…

    Arguments

    Type IntentOptional AttributesName
    class(Area_SRad_BLE_T), intent(inout) :: this
    class(SrcOPT_T), intent(in) :: SrcOPT
    integer(kind=kis), intent(in) :: nbat
    real(kind=krs), intent(in) :: nph
    type(erro_t), intent(inout) :: err

    Return Value integer(kind=kis)

procedure, public :: birth_RadPho

  • private subroutine birth_RadPho(this, photon)

    give birth of a new photon from area-averaged radiance estimators for scalar radiative transfer simulation with backward Monte Carlo algorithm

    Arguments

    Type IntentOptional AttributesName
    class(Area_SRad_BLE_T), intent(inout) :: this
    type(photon_T), intent(inout) :: photon

procedure, public :: set_HGrdId

  • private subroutine set_HGrdId(this, igrd)

    set a viewing horizontal grid index [ix,iy] for current area-averaged radiance estimator

    Arguments

    Type IntentOptional AttributesName
    class(Area_SRad_BLE_T), intent(inout) :: this
    integer(kind=kis), intent(in) :: igrd

procedure, public :: set_DirHgtId

  • private subroutine set_DirHgtId(this, IdPR)

    set current are-averaged radiance estimator index i_PRad

    Arguments

    Type IntentOptional AttributesName
    class(Area_SRad_BLE_T), intent(inout) :: this
    integer(kind=kis), intent(in) :: IdPR

procedure, public :: get_HGrdNum

  • private function get_HGrdNum(this) result(res)

    get total viewing horizontal grid number nx * ny

    Arguments

    Type IntentOptional AttributesName
    class(Area_SRad_BLE_T), intent(inout) :: this

    Return Value integer(kind=kis)

procedure, public :: get_DirHgtNum

  • private function get_DirHgtNum(this) result(res)

    get total area-averaged radiance estimator number n_PRad

    Arguments

    Type IntentOptional AttributesName
    class(Area_SRad_BLE_T), intent(inout) :: this

    Return Value integer(kind=kis)

procedure, public :: get_TgtDir

  • private subroutine get_TgtDir(this, SrcOPT, photon)

    get source direction of current area-averaged radiance estimator for backward Monte Carlo simulation

    Arguments

    Type IntentOptional AttributesName
    class(Area_SRad_BLE_T), intent(in) :: this
    class(SrcOPT_T), intent(in) :: SrcOPT
    type(photon_T), intent(inout) :: photon