sfx_main.f90

!> @brief main run sfx on dataset subroutine
! ----------------------------------------------------------------------------
subroutine run_dataset(filename_out, dataset, model)

    use sfx_phys_const
    use sfx_common
    use sfx_config
    use sfx_io
    use sfx_data

    use sfx_esm, only: &
            get_surface_fluxes_vec_esm => get_surface_fluxes_vec, &
            numericsType_esm => numericsType
    use sfx_log, only: &
            get_surface_fluxes_vec_log => get_surface_fluxes_vec, &
            numericsType_log => numericsType
    use sfx_most, only: &
            get_surface_fluxes_vec_most => get_surface_fluxes_vec, &
            numericsType_most => numericsType
    use sfx_sheba, only: &
            get_surface_fluxes_vec_sheba => get_surface_fluxes_vec, &
            numericsType_sheba => numericsType
    ! --------------------------------------------------------------------------------

    ! directives list
    ! --------------------------------------------------------------------------------
    implicit none
    ! --------------------------------------------------------------------------------

    character(len=*), intent(in) :: filename_out
    type(sfxDatasetType), intent(in) :: dataset
    integer, intent(in) :: model


    ! input/output model data
    ! --------------------------------------------------------------------------------
    type(meteoDataVecType) :: meteo         !< meteorological data (input)
    type(meteoDataType) :: meteo_cell

    type(sfxDataVecType) :: sfx             !< surface fluxes (output)

    type(numericsType_esm) :: numerics_esm      !< surface flux module (ESM) numerics parameters
    type(numericsType_log) :: numerics_log      !< surface flux module (LOG) numerics parameters
    type(numericsType_most) :: numerics_most    !< surface flux module (MOST) numerics parameters
    type(numericsType_sheba) :: numerics_sheba  !< surface flux module (SHEBA) numerics parameters

    integer :: num                          !< number of 'cells' in input
    ! --------------------------------------------------------------------------------

    ! local variables
    ! --------------------------------------------------------------------------------
    integer :: i
    integer :: io, status
    ! --------------------------------------------------------------------------------


    write(*, *) ' Running SFX:'
    write(*, '(a,a)') '    model = ', trim(get_model_tag(model))
    write(*, '(a,a)') '    dataset = ', trim(get_dataset_tag(dataset%id))
    write(*, '(a,a)') '    filename[IN] = ', trim(dataset%filename)
    write(*, '(a,a)') '    filename[OUT] = ', trim(filename_out)
    write(*, '(a, g0)') '    surface type = ', dataset%surface_type
    write(*, '(a, g0)') '    h = ', dataset%h
    write(*, '(a, g0)') '    z0(m) = ', dataset%z0_m
    write(*, '(a, g0)') '    z0(h) = ', dataset%z0_h


    !< @brief define number of cells
    open(newunit = io, file = dataset%filename, iostat = status, status ='old')
    if (status /= 0) then
        write(*, *) ' FAILURE! > unable to open file: ', trim(dataset%filename)
        return
    end if

    num = 0
    status = 0
    do while (status.eq.0)
        read (io, *, iostat = status) meteo_cell%U, meteo_cell%dT, meteo_cell%Tsemi, meteo_cell%dQ
        num = num + 1
    enddo
    num = num - 1

    close(io)

    ! --- print number of elements in dataset
    write(*, '(a, g0)') '    size = ', num
    if (dataset%nmax > 0) then
        write(*, '(a, g0)') '    nmax = ', dataset%nmax
        num = min(num, dataset%nmax)
    end if


    !< @brief allocate input & output data
    call allocate_meteo_vec(meteo, num)
    call allocate_sfx_vec(sfx, num)


    !< @brief setting height & roughness
    meteo_cell%h = dataset%h
    meteo_cell%z0_m = dataset%z0_m

    !< @brief read input data
    open(newunit = io, file = dataset%filename, iostat = status, status = 'old')
    if (status /= 0) then
        write(*, *) ' FAILURE! > unable to open file: ', trim(dataset%filename)
        return
    end if
    do i = 1, num
        read(io, *) meteo_cell%U,  meteo_cell%dT,  meteo_cell%Tsemi,  meteo_cell%dQ

        meteo%h(i) = meteo_cell%h
        meteo%U(i) = meteo_cell%U
        meteo%dT(i) = meteo_cell%dT
        meteo%Tsemi(i) = meteo_cell%Tsemi
        meteo%dQ(i) = meteo_cell%dQ
        meteo%z0_m(i) = meteo_cell%z0_m
    enddo
    close(io)


    !< @brief calling flux module
    if (model == model_esm) then
        call get_surface_fluxes_vec_esm(sfx, meteo, numerics_esm, num)
    else if (model == model_log) then
        call get_surface_fluxes_vec_log(sfx, meteo, numerics_log, num)
    else if (model == model_most) then
        call get_surface_fluxes_vec_most(sfx, meteo, numerics_most, num)
    else if (model == model_sheba) then
        call get_surface_fluxes_vec_sheba(sfx, meteo, numerics_sheba, num)
    end if


    !< @brief write output data
    call write_ascii_vec11(filename_out, &
        sfx%zeta, sfx%Rib, &
        sfx%Re, sfx%B, sfx%z0_m, sfx%z0_t, &
        sfx%Rib_conv_lim, &
        sfx%Cm,sfx%Ct, sfx%Km, sfx%Pr_t_inv, num, '(11(f10.4,3x))', status)


    !< @brief deallocate input & output data
    call deallocate_meteo_vec(meteo)
    call deallocate_sfx_vec(sfx)

end subroutine


program sfx_main

    ! modules used
    ! --------------------------------------------------------------------------------
#ifdef USE_CONFIG_PARSER
    use parser_sub_f
    use parser
    use sfx_surface
    use iso_c_binding, only: C_NULL_CHAR
#endif

    use sfx_common
    use sfx_config
    ! --------------------------------------------------------------------------------

    ! directives list
    ! --------------------------------------------------------------------------------
    implicit none
    ! --------------------------------------------------------------------------------


    type(sfxDatasetType) :: dataset
    integer :: model

    character(len = 256) :: filename_out

    ! command line arguments
    ! --------------------------------------------------------------------------------
    integer :: num_args
    character(len = 128) :: arg

    character(len = 128), parameter :: arg_key_model = '--model'
    character(len = 128), parameter :: arg_key_dataset = '--dataset'
    character(len = 128), parameter :: arg_key_output = '--output'
    character(len = 128), parameter :: arg_key_nmax = '--nmax'
    character(len = 128), parameter :: arg_key_help = '--help'
    character(len = 128), parameter :: arg_key_config = "--config"

    integer :: is_output_set
    ! --------------------------------------------------------------------------------

    ! local variables
    ! --------------------------------------------------------------------------------
    integer :: i
    integer :: status
    integer :: id, nmax
    ! --------------------------------------------------------------------------------

#ifdef USE_CONFIG_PARSER
    character, allocatable :: config_field(:)
#endif


    !< @brief define default model & dataset
    model = model_esm                           !< default = ESM
    call set_dataset(dataset, dataset_mosaic)   !< default = MOSAiC
    is_output_set = 0                           !< default = auto define output filename

    !< @brief command line arguments processing
    num_args = command_argument_count()
    do i = 1, num_args
        call get_command_argument(i, arg)
        if (trim(arg) == trim(arg_key_help)) then
            write(*, *) ' sfx model, usage:'
            write(*, *) ' --help'
            write(*, *) '    print usage options'
            write(*, *) ' --model [key]'
            write(*, *) '    key = esm (default) || log || most || sheba'
            write(*, *) ' --dataset [key]'
            write(*, *) '    key = mosaic (default) || irgason || sheba'
            write(*, *) '        = lake || papa || toga || user [filename] [param]'
            write(*, *) '    param = [h] [z0(m)] [z0(h)]'
            write(*, *) ' --output [filename]'
            write(*, *) '    set output filename'
            write(*, *) ' --config [filename]'
            write(*, *) '    use configuration file'
            write(*, *) ' --nmax [value]'
            write(*, *) '    max number of data points > 0'
            stop
        end if
        if (trim(arg) == trim(arg_key_model)) then
            if (i == num_args) then
                write(*, *) ' FAILURE! > missing model [key] argument'
                stop
            end if
            
            call get_command_argument(i + 1, arg)
            model = get_model_id(arg)
            if (model == -1) then
                write(*, *) ' FAILURE! > unknown model [key]: ', trim(arg)
                stop
            end if
        else if (trim(arg) == trim(arg_key_dataset)) then
            if (i == num_args) then
                write(*, *) ' FAILURE! > missing dataset [key] argument'
                stop
            end if
            
            call get_command_argument(i + 1, arg)
            id = get_dataset_id(arg)
            if (id == -1) then
                write(*, *) ' FAILURE! > unknown dataset [key]: ', trim(arg)
                stop
            end if
            !< save nmax if previously set
            nmax = dataset%nmax
            call set_dataset(dataset, id)
            dataset%nmax = nmax

            if (dataset%id == dataset_user) then
                !< @brief user-defined dataset
                if (i + 5 > num_args) then
                    write(*, *) ' FAILURE! > incorrect arguments for [user] dataset'
                    stop
                end if

                !< filename
                call get_command_argument(i + 2, dataset%filename)
                
                !< reading 'h'
                call get_command_argument(i + 3, arg)
                call str2real(dataset%h, arg, status)
                if (status /= 0) then
                    write(*, *) ' FAILURE! > expecting real h [value]'
                    stop
                end if
                if (dataset%h <= 0) then
                    write(*, *) ' FAILURE! > h [value] should be positive'
                    stop
                end if

                !< reading 'z0(m)'
                call get_command_argument(i + 4, arg)
                call str2real(dataset%z0_m, arg, status)
                if (status /= 0) then
                    write(*, *) ' FAILURE! > expecting real z0(m) [value]'
                    stop
                end if
                
                !< reading 'z0(h)'
                call get_command_argument(i + 5, arg)
                call str2real(dataset%z0_h, arg, status)
                if (status /= 0) then
                    write(*, *) ' FAILURE! > expecting real z0(h) [value]'
                    stop
                end if
                
            end if 
        else if (trim(arg) == trim(arg_key_output)) then
            if (i == num_args) then
                write(*, *) ' FAILURE! > missing output [key] argument'
                stop
            end if
            call get_command_argument(i + 1, filename_out)
            is_output_set = 1
        else if (trim(arg) == trim(arg_key_nmax)) then
            if (i == num_args) then
                write(*, *) ' FAILURE! > missing nmax [key] argument'
                stop
            end if
            call get_command_argument(i + 1, arg)
            call str2int(dataset%nmax, arg, status)
            if (status /= 0) then
                write(*, *) ' FAILURE! > expecting int nmax [value]'
                stop
            end if
            if (dataset%nmax <= 0) then
                write(*, *) ' FAILURE! > nmax [value] should be positive'
                stop
            end if
        else if (trim(arg) == trim(arg_key_config)) then
            if (i == num_args) then
                write(*, *) ' FAILURE! > missing configuration file [key] argument'
                stop
            end if
            
            call get_command_argument(i + 1, arg)
#ifdef USE_CONFIG_PARSER
            call run(trim(arg)//C_NULL_CHAR)

            call is_varname("model.id"//C_NULL_CHAR, status)
            if (status /= 0) then
                call get_charf("model.id"//C_NULL_CHAR, config_field)
                model = get_model_id(char_array2str(config_field))
                if (model == -1) then
                    write(*, *) ' FAILURE! > unknown model [key]: ', trim(char_array2str(config_field))
                    stop
                end if
            end if

            call is_varname("dataset.id"//C_NULL_CHAR, status)            
            if (status /= 0) then
                call get_charf("dataset.id"//C_NULL_CHAR, config_field)
                id = get_dataset_id(char_array2str(config_field))
                if (id == -1) then
                    write(*, *) ' FAILURE! > unknown dataset [key]: ', trim(char_array2str(config_field))
                    stop
                end if
                !< save nmax if previously set
                nmax = dataset%nmax
                call set_dataset(dataset, id)
                dataset%nmax = nmax

                call is_varname("dataset.filename"//C_NULL_CHAR, status)
                if ((status /= 0).or.(dataset%id == dataset_user)) then
                    !< mandatory in user dataset
                    call get_charf("dataset.filename"//C_NULL_CHAR, config_field)
                    dataset%filename = char_array2str(config_field)
                end if

                call is_varname("dataset.h"//C_NULL_CHAR, status)
                if ((status /= 0).or.(dataset%id == dataset_user)) then
                    !< mandatory in user dataset
                    call get_float("dataset.h"//C_NULL_CHAR, dataset%h)
                end if

                call is_varname("dataset.z0_m"//C_NULL_CHAR, status)
                if ((status /= 0).or.(dataset%id == dataset_user)) then
                    !< mandatory in user dataset
                    call get_float("dataset.z0_m"//C_NULL_CHAR, dataset%z0_m)
                end if

                call is_varname("dataset.z0_h"//C_NULL_CHAR, status)
                if ((status /= 0).or.(dataset%id == dataset_user)) then
                    !< mandatory in user dataset
                    call get_float("dataset.z0_h"//C_NULL_CHAR, dataset%z0_h)
                end if
            end if

            call is_varname("dataset.nmax"//C_NULL_CHAR, status)
            if (status /= 0) then
                call get_int("dataset.nmax"//C_NULL_CHAR, dataset%nmax)
            end if 
        
            call is_varname("output.filename"//C_NULL_CHAR, status)
            if (status /= 0) then
                call get_charf("output.filename"//C_NULL_CHAR, config_field)
                filename_out = char_array2str(config_field)
            
                is_output_set = 1
            end if

            if (allocated(config_field)) deallocate(config_field)
#endif
        end if        
    end do

    !< @bried set auto-defined output filename 
    if (is_output_set == 0) then 
        filename_out = 'output-' // trim(get_dataset_tag(dataset%id)) // '.txt'
    end if

    !< @brief running main driver
    call run_dataset(filename_out, dataset, model)
    stop

end program