separating model run and setup code

srcF/sfx_config.f90

@@ -41,7 +41,7 @@ module sfx_config
     character(len = 16), parameter :: dataset_papa_tag = 'papa'
     character(len = 16), parameter :: dataset_toga_tag = 'toga'
     character(len = 16), parameter :: dataset_user_tag = 'user'
-    
+
     
 contains
 

srcF/sfx_main.f90

-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
+!> @brief main run sfx subroutine
+! ----------------------------------------------------------------------------
+subroutine run_sfx(dataset_id, model_id, filename_in_common, filename_in, filename_out, nmax)
 
     use sfx_phys_const
     use sfx_common
@@ -35,10 +28,10 @@ program sfx_main
     ! --------------------------------------------------------------------------------
 
 
-    integer :: dataset_id                           !< dataset ID:
+    integer, intent(in) :: dataset_id                           !< dataset ID:
     character(len = 256) :: dataset_name
 
-    integer :: model_id                             !< sfx model ID
+    integer, intent(in) :: model_id                             !< sfx model ID
     character(len = 256) :: model_name
 
     ! input/output data
@@ -56,6 +49,150 @@ program sfx_main
     integer :: num                          !< number of 'cells' in input
 
 
+    ! --- input/output filenames
+    character(len=*), intent(in) :: filename_in_common
+    character(len=*), intent(in) :: filename_in
+    character(len=*), intent(in) :: filename_out
+    ! --------------------------------------------------------------------------------
+
+    ! command line arguments
+    ! --------------------------------------------------------------------------------
+    integer, intent(in) :: nmax
+    ! --------------------------------------------------------------------------------
+
+    ! local variables
+    ! --------------------------------------------------------------------------------
+    integer :: i
+    integer :: status
+    ! --------------------------------------------------------------------------------
+
+
+    model_name = get_model_tag(model_id)
+    dataset_name = get_dataset_tag(dataset_id)
+
+    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(32, file = filename_in, iostat = status, status ='old')
+    if (status /= 0) then
+        write(*, *) ' FAILURE! > unable to open file: ', trim(filename_in)
+        return
+    end if
+
+    num = 0
+    status = 0
+    do while (status.eq.0)
+        read (32, *, iostat = status) meteo_cell%U, meteo_cell%dT, meteo_cell%Tsemi, meteo_cell%dQ
+        num = num + 1
+    enddo
+    num = num - 1
+
+    close(32)
+
+    ! --- 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
+    call allocate_meteo_vec(meteo, num)
+    call allocate_sfx_vec(sfx, num)
+
+
+    !< @brief read input data common parameters
+    open(32, file = filename_in_common, iostat = status, status = 'old')
+    if (status /= 0) then
+        write(*, *) ' FAILURE! > unable to open file: ', trim(filename_in_common)
+        return
+    end if
+    read(32, *) meteo_cell%h, meteo_cell%z0_m
+    close(32)
+
+
+    !< @brief read input data
+    open(32, file = filename_in, iostat = status, status = 'old')
+    if (status /= 0) then
+        write(*, *) ' FAILURE! > unable to open file: ', trim(filename_in)
+        return
+    end if
+    do i = 1, num
+        read(32, *) 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(32)
+
+
+    !< @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)
+    else if (model_id == model_most) then
+        call get_surface_fluxes_vec_most(sfx, meteo, numerics_most, num)
+    else if (model_id == 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
+    ! --------------------------------------------------------------------------------
+
+
+    integer :: dataset_id                           !< dataset ID:
+    character(len = 256) :: dataset_name
+
+    integer :: model_id                             !< sfx model ID
+    character(len = 256) :: model_name
+
+    ! input/output data
+    ! --------------------------------------------------------------------------------
     ! --- input/output filenames
     character(len = 256) :: filename_in_common
     character(len = 256) :: filename_in
@@ -253,98 +390,18 @@ program sfx_main
         filename_in_common = get_dataset_param_filename(dataset_id)
         filename_in = get_dataset_filename(dataset_id)
     end if  
-    
-    if (is_output_set == 0) filename_out = 'output-' // trim(dataset_name) // '.txt'
-
-
-    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, iostat = status, status ='old')
-    if (status /= 0) then
-        write(*, *) ' FAILURE! > unable to open file: ', trim(filename_in)
-        stop
-    end if
-
-    num = 0
-    status = 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
+    if (is_output_set == 0) filename_out = 'output-' // trim(dataset_name) // '.txt'
 
 
-    !< @brief allocate input & output data
-    call allocate_meteo_vec(meteo, num)
-    call allocate_sfx_vec(sfx, num)
+    call run_sfx(dataset_id, model_id, filename_in_common, filename_in, filename_out, nmax)
 
 
 #ifdef USE_CONFIG_PARSER
     call get_float("dataset.h"//C_NULL_CHAR, meteo_cell%h)
     call get_float("dataset.z0_m"//C_NULL_CHAR, meteo_cell%z0_m)
-#else 
-    !< @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)
 #endif
 
-
-    !< @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)
-    else if (model_id == model_most) then
-        call get_surface_fluxes_vec_most(sfx, meteo, numerics_most, num)
-    else if (model_id == 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)
-
 #ifdef USE_CONFIG_PARSER
     deallocate(config_model_name)
     deallocate(config_dataset_name)
@@ -354,10 +411,5 @@ program sfx_main
     !if (is_output_set == 0) deallocate( fn_out ) 
 #endif
 
-
-    ! *: remove formats: not needed
-    10 format (f8.4,2x,f8.4)
-    20 format (11(f10.4,3x))
-
     stop
 end program
\ No newline at end of file