sfx_config.f90

#include "../includeF/sfx_def.fi"

!> @brief surface flux model config subroutines
 module sfx_config

    ! modules used
    ! --------------------------------------------------------------------------------
    ! --------------------------------------------------------------------------------

    ! directives list
    ! --------------------------------------------------------------------------------
    implicit none
    ! --------------------------------------------------------------------------------
    public :: set_dataset
    public

    !> @brief model enum def.
    integer, parameter :: model_esm = 0             !< ESM model
    integer, parameter :: model_log = 1             !< LOG simplified model
    integer, parameter :: model_most = 2            !< MOST model
    integer, parameter :: model_sheba = 3           !< SHEBA model
    integer, parameter :: model_sheba_noit = 4           !< SHEBA model noniterative
    integer, parameter :: model_most_snow = 5       !< MOST_SNOW model
    integer, parameter :: model_sheba_coare = 6       !< MOST_SNOW model
    
    character(len = 16), parameter :: model_esm_tag = 'esm'
    character(len = 16), parameter :: model_log_tag = 'log'
    character(len = 16), parameter :: model_most_tag = 'most'
    character(len = 16), parameter :: model_sheba_tag = 'sheba'
    character(len = 16), parameter :: model_sheba_noit_tag = 'sheba_noit'
    character(len = 16), parameter :: model_most_snow_tag = 'most_snow'
    character(len = 16), parameter :: model_sheba_coare_tag = 'sheba_coare'

    !> @brief dataset enum def.
    integer, parameter :: dataset_mosaic = 1        !< MOSAiC campaign
    integer, parameter :: dataset_irgason = 2       !< IRGASON data
    integer, parameter :: dataset_sheba = 3         !< please spell 'SHIBA'
    integer, parameter :: dataset_lake = 4          !< Kuivajarvi data
    integer, parameter :: dataset_papa = 5          !< Papa station (ocean) data
    integer, parameter :: dataset_toga = 6          !< Toga (ocean) data
    integer, parameter :: dataset_user = 7          !< used defined dataset

    character(len = 16), parameter :: dataset_mosaic_tag = 'mosaic'
    character(len = 16), parameter :: dataset_irgason_tag = 'irgason'
    character(len = 16), parameter :: dataset_sheba_tag = 'sheba'
    character(len = 16), parameter :: dataset_lake_tag = 'lake'
    character(len = 16), parameter :: dataset_papa_tag = 'papa'
    character(len = 16), parameter :: dataset_toga_tag = 'toga'
    character(len = 16), parameter :: dataset_user_tag = 'user'

    type :: sfxDatasetType 
        integer :: id
        character(len = 256) :: filename
        integer :: nmax

        integer :: surface, surface_type
        real :: h, z0_m, z0_h, lai, depth
    end type


contains

    function get_model_id(tag) result(id)
        implicit none
        character(len=*), intent(in) :: tag
        integer :: id

        id = - 1
        if (trim(tag) == trim(model_esm_tag)) then
            id = model_esm
        else if (trim(tag) == trim(model_log_tag)) then
            id = model_log
        else if (trim(tag) == trim(model_most_tag)) then
            id = model_most
        else if (trim(tag) == trim(model_sheba_tag)) then
            id = model_sheba
        else if (trim(tag) == trim(model_sheba_noit_tag)) then
            id = model_sheba_noit
       else if (trim(tag) == trim(model_most_snow_tag)) then
            id = model_most_snow 
        else if (trim(tag) == trim(model_sheba_coare_tag)) then
            id = model_sheba_coare 
       end if

    end function

    function get_model_tag(id) result(tag)
        implicit none
        integer :: id
        character(len=:), allocatable :: tag

        tag = 'undefined'
        if (id == model_esm) then
            tag = model_esm_tag
        else if (id == model_log) then
            tag = model_log_tag
        else if (id == model_most) then
            tag = model_most_tag
        else if (id == model_sheba) then
            tag = model_sheba_tag
        else if (id == model_sheba_noit) then
            tag = model_sheba_noit_tag
        else if (id == model_most_snow) then
            tag = model_most_snow_tag
        else if (id == model_sheba_coare) then
            tag = model_sheba_coare_tag
        end if 

    end function

    function get_dataset_id(tag) result(id)
        implicit none
        character(len=*), intent(in) :: tag
        integer :: id

        id = - 1
        if (trim(tag) == trim(dataset_mosaic_tag)) then
            id = dataset_mosaic
        else if (trim(tag) == trim(dataset_irgason_tag)) then
            id = dataset_irgason
        else if (trim(tag) == trim(dataset_sheba_tag)) then
            id = dataset_sheba
        else if (trim(tag) == trim(dataset_lake_tag)) then
            id = dataset_lake
        else if (trim(tag) == trim(dataset_papa_tag)) then
            id = dataset_papa
        else if (trim(tag) == trim(dataset_toga_tag)) then
            id = dataset_toga
        else if (trim(tag) == trim(dataset_user_tag)) then
            id = dataset_user
        end if

    end function

    function get_dataset_tag(id) result(tag)
        implicit none
        integer, intent(in) :: id
        character(len=:), allocatable :: tag

        tag = 'undefined'
        if (id == dataset_mosaic) then
            tag = dataset_mosaic_tag
        else if (id == dataset_irgason) then
            tag = dataset_irgason_tag
        else if (id == dataset_sheba) then
            tag = dataset_sheba_tag
        else if (id == dataset_lake) then
            tag = dataset_lake_tag
        else if (id == dataset_papa) then
            tag = dataset_papa_tag
        else if (id == dataset_toga) then
            tag = dataset_toga_tag
        else if (id == dataset_user) then
            tag = dataset_user_tag
        end if

    end function

    subroutine set_dataset(dataset, id)
        use sfx_surface
        implicit none
        type(sfxDatasetType), intent(out) :: dataset
        integer, intent(in) :: id
        
        integer :: id_check
        
        id_check = get_dataset_id(get_dataset_tag(id))
        if (id_check == -1) return 

        dataset%id = id
        dataset%filename = get_dataset_filename(id)
        dataset%nmax = 0

        dataset%surface = surface_snow
        dataset%surface_type = surface_snow
        dataset%z0_h = -1.0
        dataset%lai = 1.0
        dataset%depth = 10.0

        if (id == dataset_mosaic) then
            dataset%h = 6.0
            dataset%z0_m = 0.0078
             dataset%surface_type = surface_snow
        else if (id == dataset_irgason) then
            dataset%h = 9.2
            dataset%z0_m = 0.01
        else if (id == dataset_sheba) then
            dataset%h = 3.19
            dataset%z0_m = 0.001
        else if (id == dataset_lake) then
            ! *: check & fix values
            dataset%h = 10.0
            dataset%surface = surface_lake
            dataset%z0_m = -1.0
        else if (id == dataset_papa) then
            dataset%h = 10.0
            dataset%surface = surface_lake
            dataset%z0_m = -1.0
        else if (id == dataset_toga) then
            ! *: check & fix values
            dataset%h = 15.0
            dataset%surface = surface_lake
            dataset%z0_m = -1.0
        end if        
       write (*,*) dataset%surface, 'dataset%surface'
    end subroutine

    function get_dataset_filename(id) result(filename)
        implicit none
        integer :: id
        character(len=:), allocatable :: filename
    
        filename = ''
        if (id == dataset_mosaic) then
            filename = DATASET_DIR // 'MOSAiC.txt'
        else if (id == dataset_irgason) then
            filename = DATASET_DIR // 'Irgason1.txt'
        else if (id == dataset_sheba) then
            filename = DATASET_DIR // 'Sheba1.txt'
        else if (id == dataset_lake) then
            filename = DATASET_DIR // 'Kuivajarvi.txt'
        else if (id == dataset_papa) then
            filename = DATASET_DIR // 'Papa.txt'
        else if (id == dataset_toga) then
            filename = DATASET_DIR // 'Toga.txt'
        end if

    end function

end module sfx_config