Skip to content
Snippets Groups Projects
sfx_main.f90 9.18 KiB
Newer Older
    ! modules used
    ! --------------------------------------------------------------------------------
Evgeny Mortikov's avatar
Evgeny Mortikov committed
    use sfx_phys_const
Evgeny Mortikov's avatar
Evgeny Mortikov committed
    use sfx_esm_param
    use sfx_esm
    ! --------------------------------------------------------------------------------

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

    !> dataset ID:
    !>      = 0, USER
    !>      = 1, MOSAiC dataset
    !>      = 2, IRGASON dataset
    !>      = 3, SHEBA dataset
    integer :: dataset_id
    character(len = 256) :: dataset_name
    integer, parameter :: dataset_MOSAiC = 1
    integer, parameter :: dataset_IRGASON = 2
    integer, parameter :: dataset_SHEBA = 3         !> please spell 'SHIBA'
    integer, parameter :: dataset_USER = 4          !> used defined dataset

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

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

    type(numericsType) :: numerics          !> surface flux module numerics parameters

    integer :: num                          !> number of 'cells' in input


    ! --- input/output filenames
    character(len = 256) :: filename_in_common
    character(len = 256) :: filename_in
    character(len = 256) :: filename_out
    ! --------------------------------------------------------------------------------

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

    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_mosaic = 'mosaic'
    character(len = 128), parameter :: arg_key_irgason = 'irgason'
    character(len = 128), parameter :: arg_key_sheba = 'sheba'
    character(len = 128), parameter :: arg_key_user = 'user'

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

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


    !> @brief define dataset
    dataset_id = dataset_MOSAiC     !> default = MOSAiC

    is_output_set = 0
    nmax = 0
    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(*, *) ' --dataset [key]'
            write(*, *) '    key = mosaic || irgason || sheba || user [files]'
            write(*, *) '    files = in-common-file in-file out-file'
            write(*, *) ' --output [file]'
            write(*, *) '    set output filename '
            write(*, *) ' --nmax [value]'
            write(*, *) '    max number of data points > 0 '
            stop
        end if
        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)
            if (trim(arg) == trim(arg_key_mosaic)) then
                dataset_id = dataset_MOSAiC
            else if (trim(arg) == trim(arg_key_irgason)) then
                dataset_id = dataset_IRGASON
            else if (trim(arg) == trim(arg_key_sheba)) then
                dataset_id = dataset_SHEBA
            else if (trim(arg) == trim(arg_key_user)) then
                dataset_id = dataset_USER
                if (i + 4 > num_args) then
                    write(*, *) ' FAILURE! > incorrect arguments for [user] dataset'
                    stop
                end if
                call get_command_argument(i + 2, filename_in_common)
                call get_command_argument(i + 3, filename_in)
                call get_command_argument(i + 4, filename_out)
            else
                write(*, *) ' FAILURE! > unknown dataset [key]: ', trim(arg)
                stop
            end if
        end if
        if (trim(arg) == trim(arg_key_output)) then
            if (i == num_args) then
                write(*, *) ' FAILURE! > missing dataset [key] argument'
                stop
            end if
            is_output_set = 1
            call get_command_argument(i + 1, filename_out)
        end if
        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(nmax, arg, status)
            if (status /= 0) then
                write(*, *) ' FAILURE! > expecting int nmax [value]'
                stop
            end if
            if (nmax <= 0) then
                write(*, *) ' FAILURE! > nmax [value] should be positive'
                stop
            end if
        end if
    end do


    !> @brief set filenames & data for specific dataset
    if (dataset_id == dataset_MOSAiC) then
        dataset_name = 'MOSAiC'
        filename_in_common = 'data/MOSAiC_zh.txt'
        filename_in = 'data/MOSAiC.txt'
        if (is_output_set == 0) filename_out = 'out_MOSAiC.txt'
    else if (dataset_id == dataset_IRGASON) then
        dataset_name = 'IRGASON'

        filename_in_common = 'data/IRGASON_zh.txt'
        filename_in = 'data/Irgason1.txt'
        if (is_output_set == 0) filename_out = 'out_IRGASON1.txt'
    else if (dataset_id == dataset_SHEBA) then
        dataset_name = 'SHEBA'

        write(*, *) ' FAILURE! > SHEBA dataset is not supported yet:( '
        stop
    else if (dataset_id == dataset_USER) then
        dataset_name = 'USER'
    else
        write(*, *) ' FAILURE! > unknown dataset id: ', dataset_id
    end if

    write(*, *) ' Running SFX model'
    write(*, *) '   dataset = ', trim(dataset_name)
    write(*, *) '   filename[IN-COMMON] = ', trim(filename_in_common)
    write(*, *) '   filename[IN] = ', trim(filename_in)
    write(*, *) '   filename[OUT] = ', trim(filename_out)


    !> @brief define number of cells
    open(1, file= filename_in, status ='old')
    status = 0

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

    close(1)

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


    !> @brief allocate input & output data
    allocate(meteo%h(num))
    allocate(meteo%U(num))
    allocate(meteo%dT(num))
    allocate(meteo%Tsemi(num))
    allocate(meteo%dQ(num))
    allocate(meteo%z0_m(num))

    allocate(sfx%zeta(num))
    allocate(sfx%Rib(num))
    allocate(sfx%Re(num))
    allocate(sfx%B(num))
    allocate(sfx%z0_m(num))
    allocate(sfx%z0_t(num))
    allocate(sfx%Rib_conv_lim(num))
    allocate(sfx%Cm(num))
    allocate(sfx%Ct(num))
    allocate(sfx%Km(num))
    allocate(sfx%Pr_t_inv(num))


    !> @brief read input data common parameters
    open(1, file = filename_in_common, status = 'old')
    read(1, *) meteo_cell%h, meteo_cell%z0_m
    close(1)


    !> @brief read input data
    open(1, file = filename_in, status = 'old')
    do i = 1, num
        read(1, *) 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
    !> @brief calling flux module
    call get_surface_fluxes_vec(sfx, meteo, numerics, num)

    !> @brief write output data
    open(2, file = filename_out)
    do i = 1, num
        write(2, 20) sfx%zeta(i), sfx%Rib(i), &
                sfx%Re(i), sfx%B(i), sfx%z0_m(i), sfx%z0_t(i), &
                sfx%Rib_conv_lim(i), &
                sfx%Cm(i),sfx%Ct(i), sfx%Km(i), sfx%Pr_t_inv(i)
    !> @brief deallocate input & output data
Evgeny Mortikov's avatar
Evgeny Mortikov committed
    deallocate(meteo%h)
    deallocate(meteo%U)
    deallocate(meteo%dT)
    deallocate(meteo%Tsemi)
    deallocate(meteo%dQ)
    deallocate(meteo%z0_m)
    deallocate(sfx%zeta)
    deallocate(sfx%Rib)
    deallocate(sfx%Re)
    deallocate(sfx%B)
    deallocate(sfx%z0_m)
    deallocate(sfx%z0_t)
    deallocate(sfx%Rib_conv_lim)
    deallocate(sfx%Cm)
    deallocate(sfx%Ct)
    deallocate(sfx%Km)
    deallocate(sfx%Pr_t_inv)
    ! *: remove format(10) if not needed
    10 format (f8.4,2x,f8.4)
    20 format (11(f10.4,3x))