program sfx_main
! modules used
! --------------------------------------------------------------------------------
use sfx_phys_const
use sfx_common
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
! --------------------------------------------------------------------------------
! directives list
! --------------------------------------------------------------------------------
implicit none
! --------------------------------------------------------------------------------
!> dataset ID:
integer :: dataset_id
character(len = 256) :: dataset_name
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_USER = 4 !> used defined dataset
!> sfx model ID:
integer :: model_id
character(len = 256) :: model_name
integer, parameter :: model_esm = 0 !> ESM model
integer, parameter :: model_log = 1 !> LOG simplified model
! input/output 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
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_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_esm = 'esm'
character(len = 128), parameter :: arg_key_log = 'log'
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 model & dataset
model_id = model_esm !> default = ESM
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(*, *) ' --model [key]'
write(*, *) ' key = esm || log'
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_model)) then
if (i == num_args) then
write(*, *) ' FAILURE! > missing model [key] argument'
stop
end if
call get_command_argument(i + 1, arg)
if (trim(arg) == trim(arg_key_esm)) then
model_id = model_esm
else if (trim(arg) == trim(arg_key_log)) then
model_id = model_log
else
write(*, *) ' FAILURE! > unknown model [key]: ', trim(arg)
stop
end if
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 name for specific model
if (model_id == model_esm) then
model_name = "ESM"
else if (model_id == model_log) then
model_name = "LOG"
else
write(*, *) ' FAILURE! > unknown model id: ', model_id
stop
end if
!> @brief set name & filenames 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
stop
end if
write(*, *) ' Running SFX model'
write(*, *) ' model = ', trim(model_name)
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
enddo
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
enddo
close(1)
!> @brief calling flux module
if (model_id == model_esm) then
call get_surface_fluxes_vec_esm(sfx, meteo, numerics_esm, num)
else if (model_id == model_log) then
call get_surface_fluxes_vec_log(sfx, meteo, numerics_log, num)
end if
!> @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)
enddo
close(2)
!> @brief deallocate input & output data
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))
stop
end program